#!/usr/bin/perl -w 

# Copyright>        OpenRadioss
# Copyright>        Copyright (C) 1986-2022 Altair Engineering Inc.
# Copyright>    
# Copyright>        This program is free software: you can redistribute it and/or modify
# Copyright>        it under the terms of the GNU Affero General Public License as published by
# Copyright>        the Free Software Foundation, either version 3 of the License, or
# Copyright>        (at your option) any later version.
# Copyright>    
# Copyright>        This program is distributed in the hope that it will be useful,
# Copyright>        but WITHOUT ANY WARRANTY; without even the implied warranty of
# Copyright>        MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
# Copyright>        GNU Affero General Public License for more details.
# Copyright>    
# Copyright>        You should have received a copy of the GNU Affero General Public License
# Copyright>        along with this program.  If not, see <https://www.gnu.org/licenses/>.
# Copyright>    
# Copyright>    
# Copyright>        Commercial Alternative: Altair Radioss Software 
# Copyright>    
# Copyright>        As an alternative to this open-source version, Altair also offers Altair Radioss 
# Copyright>        software under a commercial license.  Contact Altair to discuss further if the 
# Copyright>        commercial version may interest you: https://www.altair.com/radioss/.    

use File::Basename;
use Data::Dumper;

$debug = 0 ;

$prog_name = $0 ;
$prog_name =~ s/.*\/// ;


# open(my $trace_fh,">>/tmp/mytrace.log");
# print $trace_fh "\n\n\n#####################################################################\n";
# print $trace_fh "       STARTING at ".localtime."\n";
# print $trace_fh "#####################################################################\n\n\n";


# defaults.
$local_executable     = "QA.code" ;  # for windows it is "QA.code.exe" ;
$save_folder          = ""; # if non empty then following 4 are not used
$screen_output_dir    = "Screen_Output" ;
$out_files_dir        = "Output_files" ;
$extracted_data_dir   = "Extracted_data" ;
$saved_files_dir      = "Saved_files" ;
$qa_constants_file    = "or_QA.constants" ;
$qa_fem_files_file    = "or_QA.files_all" ; #moved to if() below
$local_fem_file       = "" ;      # each example will run as this, "run.fem"
$local_run_extract    = "OS-qa.extract"; # this is what exec creates
$pass1extract         = "_pass_1_reference.extract"; # for self reference
$pass2extract         = "_pass_2_reference.extract"; # for self reference
$qa_summary           = "QA.summary" ;
$qa_screen            = "QA.capture" ;
$qadiaginc            = "qadiags.inc" ;
$qacards              = "" ;
$look_for_gz          = ".gz";
$force_extract_overwrite = 0;
$have_extract2        = 0;
$force_echo           = 0;
$echo_radioss         = 0;
$echo_radioss_tolerances = 0;
$qadiags_content=0;
$nono_files           = $local_run_extract;
@cleanup_files        = ("control.inp","STAT","osstmp.hma","osstmp_tet.hma","%.*") ;
$save_out_files       = 0;
$verbose              = 0;
$expverbose           = 0;
$show_extract_full    = 0; # show non failed lines in extract
$echo_marks           = 0;
$fix_tolerances       = 0;
$add_missing_extract  = 0;
$show_extract         = 0;
$infinity             = 0;
$skip_tests           = 0;  # dummy run, without exec
$use_reset_tolerances = 0;  # phlex tolerance is for few tests or more
$input_ext            = ".fem" ; # This is define FEM command for or_QA.files
$input_path           = "";
$run_id_file          = ".run.id";
$exe_name_file        = ".qa_last_exe_name";
$failure_file         = ".qa_fail_list" ;
$skipfmt              = "" ; # extract lines which should be skipped
my %test_already_run1;
my %test_already_run2;
my %issue_tab_by_dev;
$timing_check         = 0 ; # activates verification of time marks
$margin               = 1.5 ; # how strict the checks should be
@timing_stats_min     = (1e5,1e5,1e5,1e5,1e5,1e5,1e5) ;
@timing_stats_max     = (0,0,0,0,0,0,0) ;
@timing_stats_above   = (0,0,0,0,0,0,0) ;
@timing_stats_below   = (0,0,0,0,0,0,0) ;
@timing_stats_total   = (0,0,0,0,0,0,0) ;
$corr_up              = 0 ;
$corr_down            = 0 ;
$translator           = "" ; # path to translator script
@alternate_extract_file = () ;
$extractinif          = 0;
$has_stack            = 0;
$has_match            = 0;
$use_abs_values       = 0; # for local/global comparison without sign
$fix_qa_files         = 0; # add/fix marks to or_QA.files_bak
$double_check         = 0; # repeat qa to make sure that failures are true
$repeat_qa            = 0; # number of repeats to all qa
$timeout              = 0; # if set, exec will set alarm to kill runaways
$xtra_args_test       ="";
$count_timeout        = 0;
$list_timeout         = "" ;
$longest_time         = 0;
$longest_test         = "" ;
$long_out_line        = "" ;
$longest_out          = 0;
$nlonglino            = 0;
$no_count_timeout     = 0;
$notrack_timeout      = 0;
$output_failures_stdout = 0;
$output_xtra_infos    = 0;
$listing_file         ="";

$user_prog_args       = "" ;
$winefront            = "";
$safe_run             = 0 ;  # finds or creates directory with .run.id==done
$extract_suffix       = "" ; # optional suffix for extract files
$echo_test            = 0 ;  # special mode for ECHO
$run_err_list         = 0 ;  # 1 to count success runs (in '@' mode)
$no_lic_falures       = "";
$del_suffix_extract   = 0;
$use_which_extract    = 1;
$check_newfile        = 0;
$precision_l          = 14;
$precision_s          = $precision_l."s";
$precision            = $precision_l.".8g";
$selfreference        = "";   # --self_reference="whatever" ;
$selfref_pass         = 0;
# debug 4 bea
$dbg_stopqa_infos_extract = 0;
$sensitivity          = 0;
$sensitivity_xalea    = 0;
$sensitivity_n        = 0;
$test_start_location  = 0;
$sensitivity_cur_n    = 0;
$sensitivity_i8       = 0;
$sensitivity_set_extract =0;

# XXXXXX Add tolerance for all model (provide automatic way to do it from qa_script)
my $sensitivity_set_recommended_tolerances = 0;
my $sensitivity_set_recommended_tolerances_submit = 0;
my $sensitivity_no_constraint = 0;
my @qafile_current;
my @qafile_current_orig;
my $qafile_file_current;
my $qafile_must_be_rewritten = 0;
my $qafile_must_alert_by_mail = 0;
my $qa_sensitivity_contraints_file = 'qa_sensitivity_contraints';
my %sensitivity_contraints;
my %sensitivity_test_alert_email_abort;
my %sensitivity_test_alert_email_warnings;
my %sensitivity_cpts = ('inserted' => 0, 'aborted' => 0, 'empty' => 0 );
my $sensitivity_stats_for_email = $saved_files_dir.'/QA_ALL_sens_stats_n_sampling_or_QA.files_all';

# XXXXXX integrate solver run manager in RD QA
# We can run binaries through hwsolver tcl script either in one pass (non reg is done against ref.extract file)
# => use --hwsolvermanager option
# or in 2 passes (one std run one trhough the hwsolver script) strict non reg
# => use --self_reference="-hwsolvermanager ...""
my $hwsolvermanager = 0;
my $hwsolvermanager_args;

# XXXXXX enable automatically DO_QA=on when running qa_script for a 'qaprint' qa
# This array will store qaprint status (enabled or not) depending on the QA number, to retrieve the information in email sending step
my @qaprint_qas_enabled;
# END XXXXXX

# XXXXXX QA ERRORS and WARNINGS
my $extract_from_starter;
# END XXXXXX

# XXXXXX Check ERRORS in screen_save (in addition to diff in ref.extract) + Check bounds (ignore diff in ref.extract)
my $ignore_extract_comparison = 0;
my $ignore_check_errors = 0;
my $found_error = -1;
my $check_error_path_4_tracking = 'my_results/Copy_screensave_files_4_tracking';
my @all_check_error_found;
# END XXXXXX

# XXXXXX using attached ref files in tracking email (same as for QAPRINT)
# XXXXXX Check ERRORS in screen_save (in addition to diff in ref.extract) + Check bounds (ignore diff in ref.extract)
# Clean possible previous directories
my $copy_extract_path_4_tracking = 'my_results/Copy_extract_files_4_tracking';
system("rm -rf $copy_extract_path_4_tracking");
system("rm -rf $check_error_path_4_tracking");
# END XXXXXX XXXXXX

$keep_results         = 0;
$create_ref           = 0;
$keep_results_dir = "my_results";
$test_path_requested  = "";
$test_name_requested  = "";
$noretrack            =0;
$max_fixed_days       =30;
$mail_report_flag     =0;
$tracker_failures_suffix="";
$clean_local_file     =1;
$system_run           =0;
$tests_titles         =0;
$track_steps          =1;
$no_random            =0;
$input_check_script   ="";
$tracker_shortcut_max_cls = 5;
$tracker_shortcut_max_failures = 5;
$i_tracker_shortcut   = 0;
@all_root_cleanup=();
$cl_executable="xxxxx";
%tol_set=();
$no_check_emax=0;


$test_id=0;
$full_test_id=0;
$nofull_track=1;

@qamail=('xxxxxx');
$qamail=join(',',@qamail);
$test_group='';
%test_tolerances=();
%within_tolerances=();
%within_tolerances0=();
$tolerance_type='';
$tolerance_code=0;
$observed_diffs="";
$clean_failures=0;
@orig_extract1=();
@new_extract1=();
my %extract_ref_values; # Used to store values from the original reference extract file
my %emax_by_test_id; # Used to store all emax values for each test_id

$license_check_qa     = "1_1";
# these error codes are traced and reported at end
@err_ids_traced       = ( 2.0, 155.0, 169.0, 207.0, -1.0, 9012.0, 1923.0 );
foreach $errcode (@err_ids_traced) {
    $err_trace{$errcode} = "" ;
    $err_counts{$errcode} = 0 ;
}
$include_file_name = "" ;
$in_include = 0;
$main_test_id = 0;
$required_example = "" ;
$test_group= "" ;
$required_example_subfile = "" ;
$qa_skip_list = "" ;
$use_stdout = 0;
$dbgout = 0;
$print_version = 0;
$aborted_run = 0 ;
$ever_aborted = 0;
$abort_reason = "";
$running_double_check = 0;
$last_traced_qa = "";
$exec_in_place = 0;
$fix_atag = 0;
$no_skip_atag = 0;
$search_for_nan = 0;
$within_else = 0;
$paraqa = 0;
$parasumopen = 0;

$exec_script      = "";
$exec_script_args = "";
$preqa_run        = "";
$postqa_run       = "";
$sanity_stop      = 1 ; # set to zero to run till end
$full_diffs       = 1 ;
$quiet            = 0 ; # run really quiet
$perldebug        = "" ; # call or_radioss.pl with perl -d 
$git_opened = ""; # list of modified files - if active
@p4_local_files = (); # list of all files to checkin inside single example
$git_deleted = "";
$files_at_start = 0;
$wall_at_start = 0.0;
$cpu_at_start = 0.0;
$usecqaext        = 0 ; #use cqa 
$nightlyqa        = 0 ; #output detail.info
$rptbranch        = "UNKNOWN" ; #output detail.info
$noerrqafile     = ""; #file contains non-err qa list
$noerrqalist     = "";
$runmpiqa        = 0 ; #default is serial qa
$doslines        = 0 ; #1- do checks for non-ASCII files
$scratch_count   = 0 ; # count scratch files present
$filelist{"Leftover files"} = "(last example)";
$filelist_bad{"Non-ASCII files"} = "(last example)";
$h3dtoxmlexec    = "";
$local_h3d_xml     = "run.h3d_xml";
$local_h3d_extract = "run.h3d_extract";
@h3d_extract_file  = ();
#-------------------------
# filenames allowed after the run without warning (these are qa specific,
#   solver specific will come from or_QA.constants options
@expectfile = ( "brief.info", ".run.id", "qaruns.summary", 
    "detail.info", ".each-qa-start", ".qa_up" );
@expectfileext = (); # filename extensions allowed after the run without warning
$extract_path = "";  # extract files path (possibly relative to input file)

@global_keywords = () ; # from --keywords
$has_global_keywords = 0;
@local_keywords  = () ; # from keywords in or_QA.files

$p1= "";$p4= "";$p5= ""; # to avoid warnings with non-standard df
$loc_zero = 0;
$loc_diff = 0;
$skip_becse_require = "";
$after_execute        = 0;  # for multistep example
$skip_this_multi_test = 0;

$changelist_current = 0;    # for the tracker functionality
$changelist_minimum = 0;
@changelists = ();
$running_tracker = 0;
$track_changes_txt = "";
$track_eliminated   = "";   # old examples eliminated from tracking
$eq_line = "="x75 . " \n";

$knt_bad_add = "";
$knt_bad_ovr = ""; # list bad runs in add/overwrite
$has_bad_example = 0;
$knt_bad_example = "" ; # miss qadiags, or bad DIAGs

# determine the user
$username=`whoami`;
chomp($username);
# determine the OS and hosttype
$uname = `uname` ;
$hostname = lc(`hostname`) ;
chomp ($uname) ;
chomp ($hostname) ;
# trim domain.com if present
$dummy = index($hostname,".");
if ( $dummy > 2 ) {
    $hostname = substr ( $hostname, 0, $dummy  ) ;
}
$hostname = substr ( $hostname, 0, 8 ) ;
while ( substr( $hostname, -1) le " " ) {
    $hostname = substr( $hostname, 0, -1);
}
$here = "./" ;
if ( $uname =~ /CYGWIN/ ) {
    $platform = "NT" ;
    $here = "" ;
    $local_executable     = "QA.code.exe" ;
}elsif ( $uname =~ /Windows/ ) {
    $platform = "NT" ;
    $here = "" ;
    $local_executable     = "QA.code.exe" ;
}else{
    $platform = "UNIX" ;
}
$executable = "unknown" ;
$timezone = `date` ;

if ( $uname =~ /Linux/ ) {
#   --------Linux--------        
   $muname=`uname -m`;
   chomp ($muname);
   if ( $muname =~ /i686/ ) {
     $dplatform="linux32";  
     $h3dtoxmlexec    ="./h3dtoxml_Linux_I.exe";
   }elsif ( $muname =~ /x86_64/ ) {
     $dplatform="linux64";  
     $h3dtoxmlexec    ="./h3dtoxml_Linux_I.exe";
   }elsif ( $muname =~ /ia64/ ) {
     $dplatform="linuxia64"; 
   }else {   
     $dplatform="linux_Unknown";
   }
}else{
   $dplatform="Unknown_Unknown";
}



$tmp_exec_name = "";
if ( open (LOCEXE, "< QA.exec_name") ) {
    $tmp_exec_name = <LOCEXE>;
    chomp $tmp_exec_name ;
    close LOCEXE;
}

$perl_mode = "UNIX" ;
if ( $platform eq "NT" ) {
    $uname .= "<Perl=$^O>" ;
    if ( $^O eq "MSWin32" ) {
  $perl_mode = "DOS" ;
  $here = "" ;
  $ppid = int(rand(20000))+123456;
    } else {
  $ppid = getppid();
  if ( $tmp_exec_name eq "" ) {
      $here = "./" ;
  }
    }
} else {
    $ppid = getppid();
}

if ( $tmp_exec_name ne "" ) {
    $local_executable = sprintf ( "%s_%d_%s", $tmp_exec_name , $ppid, (getlogin || getpwuid($<) || "Kilroy") );
    if ( $platform eq "NT" ) { $local_executable .= ".exe" ; }
    $here = "";
}

# the smallest number where we can no longer distinguish between int and
# double/float
# TL changed - we compare as ints only if they are small
$biggest_int          = 1000000 ;
    
$run_debugger = 0 ;
$debugger_command = "gdb" ;

# parse the command line

chomp ( $pwd = `pwd` ) ;
delete $ENV{"CWD"} ; # This is to un-fool p4 e.g. when softlinks are present
$tmp = 0;
$n = 0;
$run_mark = "" ;

####################################################### &read_arg_options
&read_arg_options () ;

# XXXXXX Add tolerance for all model (provide automatic way to do it from qa_script)
# Storing sensitivity constraints
# Remove possible previous file (sensitivity stats for email)
if ($sensitivity_set_recommended_tolerances) {
  # Load constraints
  open(QA_CONTRAINTS,"< $qa_sensitivity_contraints_file");
  for my $line (<QA_CONTRAINTS>) {
    ($line =~ /^#/ or $line =~ /^ *$/) and do { next; };

    $line =~ /^(.*):(.*)$/ and do {
      my $val = $2;
      chomp $val;
      $sensitivity_contraints{$1} = $val;
    };
  }
  close(QA_CONTRAINTS);
}
if (-f $sensitivity_stats_for_email) {
  unlink $sensitivity_stats_for_email;
}

# Storing all HM (only HM_*) env variables in their original state
# Some variables defined in --self_reference="-ref_env_HM_XXX=XXX" could overwrite these variable in pass 1
# We must be able to restore the variable to its initial value in pass 2
my %env_vars_orig;
my @all_env_vars =  `env`;
for my $elem (@all_env_vars) {
  my @var = split('=',$elem);
  if (defined $var[1] and ($var[0] =~ /^HM_/ or $var[0] =~ /^RAD_CFG_PATH/)) {
    $env_vars_orig{$var[0]} = $var[1];
  }
}
my @selfreference_args_ref_env=map {chomp($_);$_ } split(',',$selfreference);

# print "----------\%env_vars_orig-------------\n";
# print Dumper %env_vars_orig;
# print "---------------------------------------\n";
# exit;
# End

$opts_header = "  :" ;
$tmp = 0;
$runargs ="";
$runargs_compute ="";
@tmp_runargs_compute=();
%failures=();
%detected_changes=();
%failures_infos=();
our %failures;
our %failures_infos;
%tests_infos=();
while ( $ARGV[$tmp] ) {
    $a = $ARGV[$tmp] ;
    if ( $a =~ /^--/ ) {
      $run_options_line .=  "$opts_header $a" ;
      $runargs =$runargs.' '.$a;
      if ($a !~ /^--quiet$/ and 
          $a !~ /^--perldebug$/ and
          $a !~ /^--debug$/ and 
          $a !~ /^--debug-stopqa$/ and 
          $a !~ /^--echo$/ and 
          $a !~ /^--log$/ and 
          $a !~ /^--verbose$/ and 
          $a !~ /^--stdout$/ and 
          $a !~ /^--version$/ and 
          $a !~ /^--dir(.+)/ and 
          $a !~ /^--version$/ and 
          $a !~ /^--timeout=/ and 
          $a !~ /^--nightlyqa=/ and 
          $a !~ /^--clean_failures/ and 
          $a !~ /^--mail_report=(.*)/ and 
          $a !~ /^--branch=(.+)/) {
        push @tmp_runargs_compute,$a;
      }
      $opts_header = "";
    }
    $tmp ++ ;
}
# add changelist to $runargs_compute and remove changelist (tracker case)
if ($executable) {
  if ($changelist_minimum) {
    my @full_exe=(split('/',$executable));
    $cl_executable=$full_exe[-2];
    # $full_exe[-2]='xxxxxx';
    push @tmp_runargs_compute,join('/',@full_exe);
  }
  else {
    push @tmp_runargs_compute,$executable;
  }
}
$run_options_line .=   "\n" ;
$runargs_compute.=join(' ',sort @tmp_runargs_compute);
$failures_infos{'runargs_compute'}=$runargs_compute;
if ($clean_failures) { 
  my $val=&checksum_failures($runargs_compute);
  print "TRACKER FAILURES TRACES : clean_failures option asked (removing tracker.failures_$val)\n";
  qx(rm -f tracker.failures_$val);
}
if ($noretrack) { &read_tracker_failures }


# >>> OSSPECIFIC 
if($runmpiqa > 0){
    #ENV{HOME} is required for full qa of parallel qa, where current dir is moved
    for $mpittt (".",$ENV{HOME},"../../os/osmake/bin","../../osmake/bin","$pwd/../../os/osmake/bin","$pwd/../../osmake/bin" ) {
        if ( -e "$mpittt/prempiqa" && -e "$mpittt/mpiqa" && -e "$mpittt/postmpiqa" ) {
            $preqa_run        = "$mpittt/prempiqa";
            $exec_script      = "$mpittt/mpiqa";
            $postqa_run       = "$mpittt/postmpiqa";
            last;
        }
    }
    $extract_suffix   = '_cqa';
    $skipfmt='(dirfrqrsp_case_001|realdisp@dof_001|imagdisp@dof_001|Complexdisp@dof_001|Complexdisp@dof_001<i>|NonlinIterations)';
    $usecqaext        = 1;
}
# <<< OSSPECIFIC

if ( $fix_atag ) {
    if ( $force_extract_overwrite || $add_missing_extract == 1 ) {
  die "Can\'t use --fix_atag when fixing extract files\n" ;
    }
    if ( ! -x "mktag.exe" ) {
  die "Can\'t do that\n" ;
    }
}
if ( $quiet ) { $verbose = 0; }
if ( $n < 1 ) {
    die "Usage:\n $prog_name executable [or_QA.files_all[:flags] [dbx]]\n $prog_name --help   for more info\n";
}
    if ( $debug ) {
  print "Special arguments: $exec_script $exec_script_args "
    ." $preqa_run $postqa_run\n" ;
    }

############################### RELOCATE RUN
if ( $safe_run ) {
    &safe_run_dir () ;
}

if ( ! $run_mark ) { $run_mark = "Xab" ; }
    unlink "brief.info" ;
    open ( BRIEFINFO, ">> brief.info" ) ;
    print BRIEFINFO "Start QA  $hostname $executable $run_mark\n";
    close BRIEFINFO;

if ( ! -f $qadiaginc ) {
    system "touch $qadiaginc" ;
    if ( -f $qadiaginc . ".template" ) {
  $tmp = $qadiaginc . ".template";
  system "cp $tmp $qadiaginc";
  # this needs to be writeable for editing
  system "chmod 644 $qadiaginc" ;
    }
}
# leave marker to compare in check_new_files
system "touch .qa-start" ; if ( $required_example ) { sleep(1); }
system "touch .test-start" ; if ( $required_example ) { sleep(1); }

# open the qa_summary file
#
open (SUMMARY, ">> $qa_summary") || die "$!" ;
select((select(SUMMARY), $| = 1)[0]);  # force unbuffered mode
select((select(STDOUT), $| = 1)[0]);  # force unbuffered mode

#p4 don't work when checking out old changlist for 644
#  system "chmod 444 $qadiaginc" ;
if ( $qacards ) {
    chmod 0644, "${qadiaginc}", "${qadiaginc}.bk";
    system "cp ${qadiaginc} ${qadiaginc}.bk";
    @cards=split(/:/,$qacards);
    open ( QADIAGSINC, ">> $qadiaginc" ) || die "Error: $qadiaginc can not opened for write";
    foreach $i (@cards) {
       print QADIAGSINC "$i\n";
    }
    close QADIAGSINC;
    print "Adding the following cards into $qadiaginc\n"; 
    system "diff ${qadiaginc} ${qadiaginc}.bk";
}

if ( $preqa_run ) {
    print "Executing pre_qa_run: $preqa_run $runmpiqa\n" ;
    system ("$^X $preqa_run $runmpiqa");
}

#### activate changelist 'tracker'
if ( $changelist_minimum ) {
    if ( $executable =~ m=(.*)/([^/]*)/([^/]*)$= ) {
  $exec_tracker_path = $1;
  $exec_tracker = $3 ;
  $changelist_current = $2;

  # XXXXXX Avoid all NFS/SAMBA usage - replace by an unique rsync step
  # If the option is set we replace the beginning of the path with new dir (e.g. D:/ => X:/)
  # We let the tracker looking for older CL through remote access
  $exec_tracker_path_orig = $exec_tracker_path;
  if (defined $real_exe_dir) {
    if ($ENV{'ARCH'} eq 'win64') {
      $exec_tracker_path =~ s/^[^\/]+\//$real_exe_dir/;
    }
    else { # linux64 / linuxa64
      $exec_tracker_path =~ s/^(.*)\/EXES/$real_exe_dir\/EXES/;
    }
  }
  foreach $i (glob("$exec_tracker_path/*/$exec_tracker")) {
    if ( $i =~ m=(.*)/([^/]*)/([^/]*)$= ) {
      if ( $2 >= $changelist_minimum && $2 <= $changelist_current ) {
        if ( -x $i ) { # non execs result from aborted build
          push (@changelists, $2);
        }
      }
    }     
  }
  # force numeric sort, just in case (descending)
  @changelists = sort {$b <=> $a} @changelists;
        my $count_exe=-1;
        my @changelists1=();
        for my $cl1 (@changelists) {
          $count_exe++;
          if ($count_exe == 0) { 
            push @changelists1,$cl1;
          }
          elsif ($count_exe >= $track_steps) {
            push @changelists1,$cl1;
            $count_exe=0;
          } 
        }
        if ( $changelists[-1] != $changelists1[-1] ) { 
          push @changelists1,$changelists[-1];
        }
        @changelists=@changelists1;
  if ( $changelist_minimum < 0 && -$changelist_minimum < $#changelists ) {
      $#changelists = -$changelist_minimum;
  }
  $changelist_current = $#changelists ;
  @changelists = sort {$a <=> $b} @changelists;  # reverse sort ...
  foreach $i (0..$changelist_current) {
      $track_fails[$i] = "";
  }
    } else {
  die "Cannot track changes: exec path does not contain change number";
    }
}

if ( $debug > 1 ) { print "B4 read_const_file\n" ; } 
&read_const_file ; ##################################### QA.CONST READ
if ( $debug > 1 ) { print "After read_const_file\n" ; } 

&opendinfo();

#########################################################################
DOUBLE_CHECK_START:
#########################################################################
    

    if ( $debug > 1 ) { print "At DOUBLE_CHECK_START\n" ; } 
# split the "QA.filename:flags"
$tmp = index($qa_fem_files_file,":",0) ;
if ( $qa_fem_files_file =~ /^[0-9]/  ) {
    $required_example = substr($qa_fem_files_file, 0, $tmp ) ;
    $tmp = substr( $qa_fem_files_file, $tmp+1 ) ;
    $qa_fem_files_file = $tmp ;
} elsif ( $tmp >= 0 ) {
    $tmp1 = substr( $qa_fem_files_file, $tmp+1 ) ; # after the :
    $tmp = substr($qa_fem_files_file, 0, $tmp )  ; # before the :
    $qa_fem_files_file = $tmp ;
    if ( $tmp1 =~ /^[0-9]/  ) {
  $required_example = $tmp1 ;
    } else {
  $run_mark = $tmp1;
    }
}

$run_list = "";
if ( index($required_example, " ")>0 ) {
    # trim leading and trailing blanks, replace other with ','
    $required_example =~ s/^\s*// ;
    $required_example =~ s/\s*$// ;
    $required_example =~ tr/ /,/s ;
}
if ( index($required_example, ",")>0 || index($required_example, "-")>0 ) {
    # examples are in form n-n,n,n,n-n,n
    $run_list = $required_example;
    $required_example = "";

    &get_next_list_id ( $run_list ) ;
    $list_match = "=";
}

if ( ! $qa_fem_files_file ) { $qa_fem_files_file = "or_QA.files_all" ; }
if ( ! $run_mark ) {
    $run_mark = "X" ; # default for list run
}
if ( ! $running_double_check ) {
    $orig_run_mark = $run_mark ;
    if ( substr($run_mark,0,1) eq "X" ) {
  if ( $fix_tolerances ) {
      if ( $platform ne "NT") {
    $orig_run_mark = "R".substr($run_mark,1) ;
      } else {
    $orig_run_mark = "W".substr($run_mark,1) ;
    if ( !$extract_suffix ) {
        print ("\n**** No extract_suffix defined !!!\n\n");
    }
      }
  }
    }
}else{
    $force_echo = $force_echo;
#   $force_echo = 1;
#   $use_stdout = 1;
}
#make sure that run mark is lowercase except possibly first letter
substr($run_mark,1) = lc(substr($run_mark,1));

$required_example_subfile = "" ;
if ( $required_example ) {
    if ( int($required_example) != $required_example ) {
  $required_example_subfile = int($required_example);
    } elsif ( index($required_example, ".") > 0 ) {
    $test_group=$required_example;
  $required_example_subfile = int($required_example) ;
  $required_example = "" ;
    }
} else {
    if ( ! $run_list and ! $test_name_requested and ! $test_path_requested and ! $has_global_keywords) { $use_stdout = 0; }
    if ( $run_debugger && index($run_debugger,"<")<2 ) {
  print "Use debugger with a single test only !!\n" ;
  $run_debugger = 0;
  $debugger_command = "" ;
    } 
}
    
# End of user config section.
    if ( $debug > 1 ) { print "At End of user config section.\n" ; } 

if ( $running_double_check <= 0 ) {

$SIG{'INT'} = 'interrupt_handler';
$SIG{'TERM'} = 'interrupt_handler';
# HUP not valid for NT
if ($platform ne "NT") {
    $SIG{'HUP'} = 'interrupt_handler';
} else {
    # we can't debug in QA on Windoze, we can with idb ...
    # $run_debugger =  0; 
}
&interrupt_handler if (0); # Just to suppress warning from perl -w.

#
# copy the executable to the local area
#
# leave a trace which example is executed
if ( ! $running_double_check && ! $running_tracker ) {
    if ( open ( RUNID, "< $run_id_file" ) ) {
  $tmp = <RUNID>;
  chomp $tmp ;
  close RUNID ;
  if ( $tmp ne "done" ) {
      print "\n####### Previous QA run did not finish correctly: " .
    "status still shows:\n $tmp \n" ;
  }
    }
}
    open ( RUNID, "> $run_id_file" );
    print  RUNID "starting qa with $executable\n" ;
    close  RUNID ;

if ( $uname eq "IRIX64" ) {
    $timeout = 2*$timeout ;
    if ( $timeout ) {
  print ("Increased timeout to $timeout sec for SGI platform\n");
    }
}
if ( $executable eq '.' || $executable eq $local_executable ) {
    $tmp = "";
    if ( open (LOCEXE, "< $exe_name_file") ) {
  $tmp = <LOCEXE>;
  chomp $tmp ;
  close LOCEXE;
    }
    print "Reusing existing $local_executable  $tmp\n" ;
    if ( $tmp =~ /_d$/ ) {
  $timeout = 2*$timeout ;
  if ( $timeout ) {
  print ("Increased timeout to $timeout sec for debug executable\n");
        }
    }
    $executable = $local_executable;
} else {
    foreach  $ii ( split('[/\\\\]',$executable) ) {
  $exname = $ii;
    }
    if ( open (LOCEXE, "> $exe_name_file") ) {
  print LOCEXE $exname;
  close LOCEXE;
    }
    if ( $exname =~ /_d$/ ) {
  $timeout = 2*$timeout ;
  if ( $timeout ) {
  print ("Increased timeout to $timeout sec for debug executable\n");
        }
    }
}

if (-f $local_executable) {
    if ( $executable ne $local_executable ) {
  unlink ($local_executable)
      or die "Error deleting old exec in run area\n";
    }
}
if (-f $local_run_extract) {
    unlink ($local_run_extract);
}
# Check a few things.
if ( ! -f $executable ) {
    if ( -f "$pwd/$executable" ) { $executable = "$pwd/$executable" ; }
    else { die "$prog_name: ERROR: exec `$executable' does not exist!\n"; }
}
die "$prog_name: ERROR: exec `$executable' does not exist!\n"
   if (! -f $executable) ;
die "$prog_name: ERROR: `$executable' isn't executable!\n"
    if (! -x $executable) ;
die "$prog_name: QA file `$qa_fem_files_file' doesn't exist!\n"
   if (! -f $qa_fem_files_file) ;

if ( $required_example || $exec_in_place ) {
    $local_executable = $executable;
    if ( $platform eq "NT" ) {
  if ( $^O eq "MSWin32" ) {
      $local_executable =~ s|/|\\|g ;
  }
    }
    $here = "" ;
    $tmp_exec_name = "" ;
} elsif ( $executable ne $local_executable) {
    if ( $debug > 1 ) { print "B4 cp executable\n" ; } 
    $tmp_out = `cp $executable $local_executable 2>&1` ;
    chomp $tmp_out ;
    if ($tmp_out) {
   print "cp $executable failed for some reason: \n $tmp_out\n" ;
    }
}
if ( $tmp_exec_name ne "" ) {
    print "**** Executable stored as $local_executable ****\n" ;
}

die "$prog_name: ERROR: $local_executable disappeared ! Why, oh why !?!? \n"
   if (! -f $local_executable) ;

# find required print accuracy based on global diff_tolerance
$tmp = $diff_tolerance;
if ( $tmp > $zero_tolerance ) { $tmp = $zero_tolerance; }
$tol = 2;
while ( $tmp < 1.0 ) {
    $tmp *= 10.0;
    $tol ++;
}
$precision = sprintf("%d.%dg",$tol+6,$tol);
if ( $debug > 1 ) {
    print "Eps: $diff_tolerance,$zero_tolerance, Format:$precision\n" ;
}

if ( $ENV{"USE_WINE"} ) {
    $tmp = "USE_WINE";
    $winefront = "$ENV{$tmp} -- ";
}

}  # end part not executed upon running double check


if ( ! $running_double_check ) {
#
# write executable name to screen and to the summary file
#
$mindiff=0;
$houdiff=0;
#========================================================================
#========================================================================
if ( ! $running_tracker ) {
    &out_file ( $eq_line ) ;
    &out_file ( $eq_line ) ;
    &out_file ( "===  Performing QA on :  $winefront $executable\n" ) ;
}
$date = localtime ;
$time = time;
$ver_info = "" ;
($execdir,$execname) = $executable =~ m|^(.*[/\\])([^/\\]+?)$|;
if($nightlyqa !=0){print DINFO "\$run\{execdir\}=q(${execdir});\n";}
if($nightlyqa !=0){print DINFO "\$run\{execname\}=q(${execname});\n";}

@rundt=localtime;
$rundate=sprintf("%4d-%02d-%02d",$rundt[5]+1900,$rundt[4]+1,$rundt[3]);
$runtime=sprintf("%2d:%02d:%02d",$rundt[2],$rundt[1],$rundt[0]);
$currenttime=&counttime($rundt[5]+1900,$rundt[4]+1,$rundt[3],$rundt[2],$rundt[1],$rundt[0]);
$timeexitstr=sprintf("QA   time is %s %s with timestamp %d\n",$rundate,$runtime,$currenttime);
if($nightlyqa !=0){print DINFO "\$run\{rundate\}=q($rundate);\n";}
if($nightlyqa !=0){print DINFO "\$run\{runtime\}=q($runtime);\n";}

if ( $print_version ) {
    if ( $platform eq "NT" ) {
      $ver_info = `strings $executable |grep OStag`;
    }else{
      $ver_info = `$executable -version 2>&1 | grep -i tag`;
    }
    chomp $ver_info ;
    my $tmp_info=0;
    if ( $ver_info ) {
  $temp = "0000000-0000000" ;
  foreach $ii ( split /\s+/, $ver_info ) {
      $temp = $ii;
  }
  if($nightlyqa !=0){print DINFO "\$run\{exectag\}=q(${temp});\n";}

  $tmp = "build-tag.pl" ;
  foreach $ttt ("./","../../os/osmake/make-files/","../../osmake/make-files/","$pwd/../../os/osmake/make-files/","$pwd/../../osmake/make-files/" ) {
      $build = $ttt . $tmp ;
      if ( -e $build ) {
    $ENV{'QADATAFMT'}='ON';
    $ver_info = "Exec built: " . `perl $build decode $temp`;
    chomp $ver_info ;
    #Exec built: 2009-02-09 14:45:00 -- linfa at ranier (Linux) -- Tag:MDL Flags: e64pBW842M_di
    if ($ver_info =~ m/^Exec built: \s*(\d*)-(\d*)-(\d*)\s*(\d*):(\d*):(\d*) -- (\S*) at (\S*).*$/){
      if($nightlyqa !=0){print DINFO "\$run\{execdate\}=q($1-$2-$3);\n";}
      if($nightlyqa !=0){print DINFO "\$run\{exectime\}=q($4:$5:$6);\n";}
      if($nightlyqa !=0){print DINFO "\$run\{execuser\}=q($7);\n";}
      if($nightlyqa !=0){print DINFO "\$run\{exechost\}=q($8);\n";}
            $tmp_info=1;
      $buildtime=&counttime($1,$2,$3,$4,$5,$6);
      $timeexitstr.=sprintf("buildtime is %4.4d-%2.2d-%2.2d %2.2d:%2.2d:%2.2d with timestamp %d\n",$1,$2,$3,$4,$5,$6,$buildtime);

      $mindiff=$currenttime-$buildtime;
      $houdiff=$mindiff/60;
      $timeexitstr.=sprintf("Timestamp difference is min: %d or hour: %d\n",$mindiff,$houdiff);

    }
    last;
      }
  } 
    } 
    if ($tmp_info == 0) {
  $ver_info = `$executable -version 2>&1 | grep -i version`;
  chomp $ver_info ;
  if($nightlyqa !=0){print DINFO "\$run\{exectag\}=q(unknown);\n";}
  if($nightlyqa !=0){print DINFO "\$run\{execdate\}=q(00-00-00);\n";}
  if($nightlyqa !=0){print DINFO "\$run\{exectime\}=q(00:00:00);\n";}
  if($nightlyqa !=0){print DINFO "\$run\{execuser\}=q(unknown);\n";}
  if($nightlyqa !=0){print DINFO "\$run\{exechost\}=q(unknown);\n";}
    }
}
if ( ! $running_tracker ) {
    if ( length ( $ver_info ) > 50 ) {
  &out_file ( "===  $ver_info\n" ) ;
  &out_file ( "===  $date\n" ) ;
    } else {
  &out_file ( "===  $date    $ver_info\n" ) ;
    }
    if ( $required_example ) {
  &out_file ( "===  Executing single test $required_example\n" ) ;    
    } elsif ( $required_example_subfile ) {
  &out_file ( "===  Executing tests from a file No. $required_example_subfile\n" ) ;
    }
    if ( $skipfmt && $usecqaext ) {
  &out_file ( "===  Skip lines: $skipfmt\n" );
    }
    if ( $required_example && $fix_qa_files ) {
  &out_file ( "*!*!*!* disabling fix_qa_files *!*!*!*\n" ) ;
  $fix_qa_files = 0;
    }
}
$cur_dir = `pwd` ;
chomp($cur_dir) ;
if ( ! $running_tracker ) {
    &out_file ( "===  $platform ($uname) $hostname  in $cur_dir\n" ) ;
}
if($nightlyqa !=0){print DINFO "\$run\{rundir\}=q($cur_dir);\n";}
if($nightlyqa !=0){print DINFO "\$run\{runhost\}=q($hostname);\n";}
if($nightlyqa !=0){print DINFO "\$run\{runuser\}=q($username);\n";}
if ( $run_debugger ) {
    &out_file ( "===  Code will be executed interactively using $debugger_command debugger\n" ) ;
}
$run_options_line = "" ;
$run_options_line .=  "$qa_fem_files_file <$run_mark> " ;
if($nightlyqa !=0){print DINFO "\$run\{runmark\}=q(${run_mark});\n";}
if($nightlyqa !=0){print DINFO "\$run\{runargs\}=q(${runargs});\n";}
if ( $user_prog_args ) {
    $run_options_line .= "===  extra args to the code: $user_prog_args\n";
}
if ( ! $running_tracker ) {
    &out_file ( "===  $run_options_line" );
    if ( $changelist_minimum ) {
  if ( $#changelists > 0 ) {
  &out_file ( $eq_line . "Tracking failures in: " . 
        join(' ',@changelists) . "\n" ) ;
  } else {
      &out_file ( $eq_line .
      "Disabling tracking: no available older executables\n" ) ;
      $changelist_minimum = 0;
  }
    }
}
&out_file ( $eq_line ) ;
} # end not running double check
&out_file ( $eq_line ) ;
#========================================================================
#========================================================================
#when nightlyqa < 0, it is a special run for tcl script checking
# if( $nightlyqa >0 && $mindiff > 18*60 && ! $running_tracker){
# print       "***Error:${execname} is more than 18 hours old. $timeexitstr Exit \n";
# print DINFO "die \"***Error:${execname} is more than 18 hours old. $timeexitstr Exit.\\n\"; \n";
# exit 1;
# }

if ( ! $save_folder ) {
@dir_list = ($screen_output_dir, $out_files_dir, $extracted_data_dir, $saved_files_dir) ;
foreach $ddir (@dir_list) {
    if ( -f $ddir ) {
        # temporary fix for previous mistake creating such file
  unlink $ddir;
    }
mkdir $ddir,0777;
system ("chmod 0777 $ddir") ;
}
}

   $FEM = uc($input_ext);
   if ( substr ($FEM,0,1) eq "." ) {
       $FEM = substr ($FEM,1) ;
   }

#
if ( $force_extract_overwrite ) {
    &out_file ( 
    "***************************************************************************\n" 
    . "***************************************************************************\n\n" 
    . "*** WARNING *** WARNING *** WARNING *** WARNING *** WARNING *** WARNING ***\n\n" 
    . "   !!! ALL FAILURE EXTRACT FILES WILL BE OVER WRITTEN !!!\n\n" 
    . "*** WARNING *** WARNING *** WARNING *** WARNING *** WARNING *** WARNING ***\n\n" 
    . "***************************************************************************\n" 
    . "***************************************************************************\n\n" ) ;
       
}

#
#initialize counters
#
$num_runs_attempted = 0 ;
$num_runs_failed    = 0 ;
$num_runs_good      = 0 ;
$old_num_runs_good  = 0;
$num_runs_skipped   = 0 ;
$num_serious_failed = 0 ;
$num_read_failures  = 0 ;
$num_no_license     = 0 ;
$num_crashes        = 0 ;
$num_no_extract_created = 0;
$include_file_id = 0;
$num_bootstrap_tests = 0 ;
$prog_args            = "" ;
$listoffailed         = "";  # full list of failures
$list_read_err        = "";  # failures with reader message
$list_tol             = "";  # failures with tolerance only
$list_error           = "";  # serious failures
$list_of_good         = "";  # only in '@' mode
$timestart            = time;
$failure_file_list    = "";
$list_of_crashed      = "";
$no_sig_failures      = 0 ;
$list_sig_failures    = "" ;
$last_sig_failure     = "";
@h3dfiles             = () ; #list of h3d files to be checked
# init mark setup
if ( $running_double_check <= 0 ) {
    $speed = substr($run_mark,0,1);
    $strict_speed = 1;
    if ( lc($speed) ne $speed ) { $strict_speed = 0; $speed = lc($speed); }
    if ( length($run_mark) > 1 ) {
  $run_mark = substr($run_mark,1);
    } else {
  $run_mark = "" ;
    }
}

if ( $local_fem_file && $local_fem_file ne "NONE" ) {
    $root     = $local_fem_file ;
    $Run_file = $root ;
    $root     =~ s/\.([^.])*$// ; # strip any extension if exists
    if ($echo_radioss) {
      $local_fem_file =~ s/D([0-9][0-9])$//;
      $local_fem_file =~ s/_([0-9][0-9][0-9][0-9])\.rad$//;
      $root=$1;
    }
    push @all_root_cleanup,$root;
} else {
    $local_fem_file = "" ; # if NONE
    $root = "";
}
####################################################################
#   HERE done with preparations, read or_QA.files.. and processing
####################################################################


#
# process or_QA.files_all file
#
$fix_echo = "";
$infile = "TCLS";
$fixfile = "FIXFIL";
open ($infile, "< $qa_fem_files_file") || die "$qa_fem_files_file: $!\n" ;
$cur_file_name =  $qa_fem_files_file;

####################################################################
# parallel qa
if ( $paraqa < 0 ) {
    $realparaqa = -$paraqa;
    $paraecho = "../../echoqa.$realparaqa";
    system("pwd");
    print "open(PARASUM,\">$paraecho\")\n";
    open(PARASUM,">$paraecho") || die "Open $paraecho failed: $!\n";
    $parasumopen = 1;
    $verbose = $expverbose;
    if ( $debug ) { print "++++Creating Group $paraqa\n"; }
}elsif ( $paraqa > 0 ) {
   #use POSIX ":sys_wait_h";
    $endqagroup = `grep include or_QA.files_all | wc -l`;
    $startqagroup = 1;
   #$endqagroup = 4;
    $paradir = "../runparaqa";
    if ( ! -d $paradir ) {
        mkdir $paradir,0777;
    }
    for ($igroup=$startqagroup;$igroup<=$endqagroup;$igroup++) {
        $groupstat[$igroup] = 0;
        $pararundir = "$paradir/runqa.$igroup";
        if ( ! -d $pararundir ) {
            mkdir $pararundir,0777;
        }
    }
    $orgarg = " ";
    $tmp = 1;
    while ( $ARGV[$tmp] ) {
        $a = $ARGV[$tmp] ;
  if ( $a =~ /^--paraqa(=)?(.*)/ ) {
        }else{
            $orgarg .= " ".$ARGV[$tmp] ;
        }
        $tmp++;
    }

    print "Running $paraqa Parallel QA in $paradir\n";

    $num_runs_attempted  = 0;
    $num_runs_good  = 0;
    $num_runs_failed  = 0;
    $num_runs_skipped  = 0;
    $listoffailed  = "";
    $num_read_failures  = 0;
    $list_read_err  = "";
    $nlist_error  = 0;
    $list_error  = " ";
    $nlist_tol  = 0;
    $list_tol  = "";
    $num_crashes  = 0;
    $list_of_crashed  = "";
    $count_timeout  = 0;
    $list_timeout  = " ";
    $no_sig_failures  = 0;
    $list_sig_failures  = "";
    $num_no_license  = 0;
    $no_lic_falures  = "";


    $rungroup = $startqagroup;
    do {

        if ( $rungroup <= $endqagroup ) {
            $pararundir = "$paradir/runqa.$rungroup";
            $addarg = " --exec_in_place --paraqa=-$rungroup --dir=$pararundir";

            $pid = fork;
            #$isleep = 4*(($endqagroup-$rungroup)%4)+1;
            if( $pid == 0 ) {
               #child
               #print "++++Creating Group $rungroup [$isleep]\n";
               #sleep 1;
               #sleep $isleep;
                if ( $debug ) { print  "$^X $0 $local_executable ${rungroup}.0 $orgarg $addarg\n"; }
               #system ("$^X $0 $local_executable ${rungroup}.0 $orgarg $addarg > /dev/null 2>&1");
                exec ("$^X $0 $local_executable ${rungroup}.0 $orgarg $addarg > /dev/null 2>&1");
               #exit 0;
            }else{
                #parent
                $groupstat[$rungroup] = $pid;
            }
            $rungroup++;
        }

        #not overload system
        do {
            $numrunning = 0;
            for ($igroup=$startqagroup;$igroup<=$endqagroup;$igroup++) {
                $ipid = $groupstat[$igroup];
                if ( $ipid > 0 ) {
                    $numrunning++;
                   #$chkipid = waitpid($ipid,WNOHANG); CYGWIN perl does not support WNOHANG
                    $chkipid = waitpid($ipid,1);
                    #print "Group $igroup $ipid $chkipid\n";
                    if ($chkipid > 0 ) {
                        $numrunning--;
                        $groupstat[$igroup] = -1;
                        if ( $debug ) { print "----Finishing Group $igroup\n"; }    
                    }
                }
            }
            if ( $numrunning >= $paraqa ) {
                #sleep 1;
                select(undef, undef, undef, 0.1);
            }
        } while ( $numrunning >= $paraqa );

        #output results in order
        for ($igroup=$startqagroup;$igroup<=$endqagroup;$igroup++) {
            $ipid = $groupstat[$igroup];
            if ( $ipid >= 0 ) {
                last;
            } elsif ( $ipid == -1 ) {
                if ( $debug ) { print "    Outputting Group $igroup\n"; }
                $groupstat[$igroup] = -2;
                $paraecho = "$paradir/echoqa.$igroup";
                open(PARAECHO,"<$paraecho") || die "Failed to open $paraecho: $!";
                $printline = 1; 
                while ( $echoline = <PARAECHO> ) {
                    if($echoline =~ m/^\=+\s*$/ && $printline == 1 ) { 
                        $printline = 0; 
                    } elsif ( $echoline =~ m/# Runs Attempted  :\s*(\d+)/ ) {
                        $num_runs_attempted += $1;
                    } elsif ( $echoline =~ m/# Runs Successful :\s*(\d+)/ ) {
                        $num_runs_good += $1;
                    } elsif ( $echoline =~ m/# Runs Failed     :\s*(\d+)/ ) {
                        $num_runs_failed += $1;
                    } elsif ( $echoline =~ m/# Runs Skipped    :\s*(\d+)/ ) {
                        $num_runs_skipped += $1;
                    } elsif ( $echoline =~ m/List of failures  :\s*( .*)/ ) {
                        $listoffailed .= $1;
                    } elsif ( $echoline =~ m/- Reader failures\s*\((\d+)\):\s*( .*)/ ) {
                        $num_read_failures += $1;
                        $list_read_err .= $2;
                    } elsif ( $echoline =~ m/- Serious failures\s*\((\d+)\):\s*( .*)/ ) {
                        $nlist_error += $1;
                        $list_error .= $2;
                    } elsif ( $echoline =~ m/- Tolerance failures\s*\((\d+)\):\s*( .*)/ ) {
                        $nlist_tol += $1;
                        $list_tol .= $2;
                    } elsif ( $echoline =~ m/- Crashes\s*\((\d+)\):\s*( .*)/ ) {
                        $num_crashes += $1;
                        $list_of_crashed .= $2;
                    } elsif ( $echoline =~ m/- Timeouts\s*\((\d+)\):\s*( .*)/ ) {
                        $count_timeout += $1;
                        $list_timeout .= $2;
                    } elsif ( $echoline =~ m/- Signal handler\s*\((\d+)\):\s*( .*)/ ) {
                        $no_sig_failures += $1;
                        $list_sig_failures .= $2;
                    } elsif ( $echoline =~ m/- License failures\s*\((\d+)\):\s*( .*)/ ) {
                        $num_no_license += $1;
                        $no_lic_falures .= $2;
                    }

                    if ($printline) {
                        print $echoline;
                    }

                }
                close(PARAECHO);

                ##copy output files
                #$outfiledir="$paradir/runqa.$igroup/scripts/Output_files";
                #if ( -d $outfiledir ) {
                #    $numoutfiles=`ls $outfiledir/ | wc -l`;
                #    if( $numoutfiles > 0 ) {
                #        system ("cp -f $outfiledir/* Output_files/");
                #    }
                #}
            }
        }

        select(undef, undef, undef, 0.1);

    } while ( $groupstat[$endqagroup] != -2 );


    # print summary
    ($usercpu, $systemcpu, $cusercpu, $csystemcpu) = times;
$ctim_fmt = &format_time ( $csystemcpu + $cusercpu );
$wtim_fmt = &format_time ( time - $timestart );

    $date = localtime ;
    &out_file ( $eq_line ) ;
    $tmp = "completed";
   #if ( $aborted_run ) { $tmp = "aborted"; }
   #if ( $running_double_check ) { $tmp = "double checked"; }
    if ( length ( "QA $tmp : $exname $hostname  $run_options_line" ) > 78 ) {
        $run_options_line = "\n $run_options_line" ;
    }

if ( ! $running_tracker ) {
    &out_file ("QA $tmp : $exname $hostname  $run_options_line");
    &out_file ( " finished at : $date (CPU: $ctim_fmt, wall $wtim_fmt)\n\n" ) ;
    &out_file ( "     # Runs Attempted  :  $num_runs_attempted\n") ;
    &out_file ( "     # Runs Successful :  $num_runs_good\n") ;
}
if ( $num_serious_failed ) {
    &out_file ( "     # Runs Failed     :  $num_runs_failed  " .
    "      (serious failures: $num_serious_failed)\n" ) ;
} else {
    &out_file ( "     # Runs Failed     :  $num_runs_failed\n") ;
}
if ( ! $running_tracker ) {
    if ( ! $required_example && $required_example_subfile ) {
        &out_file ( "     Single file No. $required_example_subfile executed\n" );
    }
    if ( $run_list ) {
        &out_file ( "     Example list $run_list\n" ) ;
    }
    if ( $run_err_list && $num_runs_good ) {
        &out_file ( "     Examples not failing ($num_runs_good): $list_of_good\n" ) ;
    }
    if ( $required_example ) {
        &out_file ( "     Example to run $required_example\n" ) ;
    } else {
        &out_file ( "     # Runs Skipped    :  $num_runs_skipped\n") ;
            if ( $num_runs_failed ) {
                &out_file ( "     List of failures  : $listoffailed\n") ;
            }
    }
   #$tmp = 0;
   #if ( $list_error ne ""  ) { $tmp ++ ; }
   #if ( $list_read_err ne "" ) { $tmp ++ ; }
   #if ( $list_tol ne ""  ) { $tmp ++ ; }
   #if ( $tmp > 1 ) {
        if ( $list_read_err ne "" ) {
            substr($list_read_err,0,1) = " ";
            &out_file ( "     - Reader failures    ($num_read_failures): $list_read_err\n" );
        }
        if ( $list_error ne ""  ) {
            substr($list_error,0,1) = " ";
            &out_file ( "     - Serious failures   ($nlist_error): $list_error\n" );
        }
        if ( $list_tol ne ""  ) {
            substr($list_tol,0,1) = " ";
            &out_file ( "     - Tolerance failures ($nlist_tol): $list_tol\n" );
        }
   #}
    if ( $num_crashes ) {
        &out_file ( "     - Crashes         :  ($num_crashes): $list_of_crashed\n") ;
    }
    if ( $count_timeout ) {
        &out_file ( "     - Timeouts        :  ($count_timeout): $list_timeout\n") ;
    }
    if ( $no_sig_failures ) {
        &out_file ( "     - Signal handler  :  ($no_sig_failures): $list_sig_failures\n") ;
    }
    foreach $errcode (@err_ids_traced) {
        if ( $err_counts{$errcode} ) {
            &out_file ( "     - Traced Err $errcode found $err_counts{$errcode} times :: $err_trace{$errcode}\n" );
        }
    }
    if ( $num_no_license ) {
        &out_file ( "     - License failures ($num_no_license): $no_lic_falures\n" );
    }
    if ( ! $required_example && ! $run_list && $longest_time && !$count_timeout ) {
        &out_file ( "     # Longest example: QA_$longest_test, $longest_time_fmt.\n");
    }
    if ( $nlonglino > 0 ) {
        &out_file ( "     # $nlonglino out files longer than 2000 lines\n     $long_out_line" ) ;
    }

}
    &out_file ( $eq_line ) ;

    &tracker_report ;
    &clean_exit;

}
####################################################################

&start_test ;
#####################################################################
############################# MAIN LOOP #############################
#####################################################################
##########:::::::::::::::::
##### !!!!! dbg_stopqa_infos_extract
my $tmp_file_input="";
my $tmp_file_extract="";

my $line_number=0;

MAIN_LOOP:

# XXXXXX Launch qa_script (starter+engine) when no engine is present in data folder (it is generated at starter time)
# Setting value to 0 before analysing the model lines
$fem_file_from_starter = 0;
# XXXXXX END


while (<$infile>) {

    $line_number++;
    if ( $aborted_run ) { last; }

    chomp ;

    next if (/^$|^\s*$/) ;  # Ignore blank lines.
    next if (/^#/) ;  # Ignore blank lines.

    if (/^\s*test\s+(\S+)/i) {
  $tmp = 1; # tmp is dummy here
    $test_start_location=tell ( $infile );
    }
    elsif ( /^\#_\#/ ) {
  $tmp = 2;
    }
    elsif ( $fix_qa_files ) {
  $fix_echo .= $_ . "\n" ;
    }
   
    if ( /^\s*if/ ) { $_ = &process_if ( $_ ); }

    next if (/^\s*\#|^$|^\s*$/) ;  # Ignore comments and blank lines.

    $_ =~ s/\s*$//;  # trim leading blanks

   if ( /^\s*include\s+(\S+)\s*(\#.*)*$/i ) {

       $include_file_name = $1;

       # print "------ READING $include_file_name ------------\n";

       if ( $in_include ) { die "Nested include\n" ; }
       $include_file_id ++;
       if ( $required_example_subfile && $required_example_subfile != $include_file_id ) {
     next; # skip include because we do not care for this one
       } 
       $in_include = 1;
       &get_tol('CONST');
#dbg       $out_buffer .= "\n--------------------------------------------------------------------------------------------\n";
#dbg       $out_buffer .= "\ninclude=$include_file_name";
#dbg       $out_buffer .= "\nnew tols :\n";
#dbg       $out_buffer .= join(',',( $diff_tolerance, $zero_tolerance, $warn_tolerance,  $rel_int_tolerance, $abs_int_tolerance, $infinity, $biggest_int, $abs_tolerance, $interval_tolerance));
#dbg       $out_buffer .= "\n--------------------------------------------------------------------------------------------\n";
#dbg       &out_file( "$out_buffer" );
       $cur_file_name = $include_file_name;
       $infile = "TCLSA" ;

      # XXXXXX Add tolerance for all model (provide automatic way to do it from qa_script)
      # Storing qafile content in an array for possible modification (adding tolerance automatically)
      # Load qafiles
      if ($sensitivity_set_recommended_tolerances) {
        open (QAFILE, "< $include_file_name") || die "missing $include_file_name:" ;
        @qafile_current = <QAFILE>;
        @qafile_current_orig = @qafile_current;
        $qafile_file_current = $include_file_name;
        $qafile_must_be_rewritten = 0;
        $qafile_must_alert_by_mail = 0;
        undef %sensitivity_test_alert_email_abort;
        close (QAFILE);
      }

       open ($infile, "< $include_file_name") || die "missing $include_file_name:" ;
       $line_number=0;
       if ( $fix_qa_files ) {
     $tmp = $include_file_name . "_fix" ;
     open($fixfile, "> $tmp") || die "cant open $tmp" ;
     print $fixfile "\n#_### INCLUDE FILE: $include_file_name \n\n" ;
     $fix_echo = "" ;
       }
       if ( @envstack > 0 ) {
     &out_file ( "WARNING: pusenv/popenv mismatch while opening include $include_file_name\n" ) ;
     while ( @envstack > 0 ) {
           pop (@envstack);
       }
       }
       $main_test_id = $test_id ;
       $test_id = 0;
       &start_test ;
       # reset global stacks
       while ( $global_slen < $#stack_global ) { pop(@stack_global); }
       while ( $global_mlen < $#match_global ) { pop(@match_global); }
       goto MAIN_LOOP ;
   }

   # these are processed even when skipping
   $unknown_line = 0 ;
      
   if (/^\s*Diff_Tolerance\s+([\d.e+-]+)\s*$/) {
       if ( ! $fix_tolerances ) {
     $diff_tolerance = $1 ;
       } else {
     $out_buffer .= ">>> skipped: Diff_Tolerance $1  for test $full_test_id\n" ;
       }
   } elsif (/^\s*Reset_Diff_Tolerance\s*/) {
       if ( ! $use_reset_tolerances ) {
          print "OBSOLETE CARD: Reset_Diff_Tolerance \n" ;
       }
       $diff_tolerance = $diff_tolerance_orig ;
   } elsif (/^\s*Relative_Int_Tolerance\s+([\d.]+)$/) {
       if ( ! $fix_tolerances ) {
     $rel_int_tolerance = $1 ;
       } else {
     $out_buffer .= ">>> skipped: Relative_Int_Tolerance $1  for test $full_test_id\n" ;
       }
   } elsif (/^\s*Reset_Relative_Int_Tolerance/) {
       if ( ! $use_reset_tolerances ) {
          print "OBSOLETE CARD: Reset_Relative_Int_Tolerance \n" ;
       }
       $rel_int_tolerance = $rel_int_tolerance_orig ;
   } elsif (/^\s*Infinity\s+([\d.]+)\s*$/) {
       if ( ! $fix_tolerances ) {
     $infinity = $1 ;
       } else {
     $out_buffer .= ">>> skipped: Infinity $1  for test $full_test_id\n" ;
       }
   } elsif (/^\s*Zero_Tolerance\s+([\d.e+-]+)\s*$/) {
       if ( ! $fix_tolerances ) {
     $zero_tolerance = $1 ;
       } else {
     $out_buffer .= ">>> skipped: Zero_Tolerance $1  for test $full_test_id\n" ;
       }
   } elsif (/^\s*Reset_Zero_Tolerance/) {
       if ( ! $use_reset_tolerances ) {
          print "OBSOLETE CARD: Reset_Zero_Tolerance \n" ;
       }
       $zero_tolerance = $zero_tolerance_orig ;
   } elsif (/^\s*Int_Tolerance\s+([\d]+)\s*$/) {
       if ( ! $fix_tolerances ) {
     $abs_int_tolerance = $1 ;
       } else {
     $out_buffer .= ">>> skipped: Int_Tolerance $1  for test $full_test_id\n" ;
       }
   } elsif (/^\s*Reset_Int_Tolerance/) {
       if ( ! $use_reset_tolerances ) {
          print "OBSOLETE CARD: Reset_Int_Tolerance \n" ;
       }
       $abs_int_tolerance = $abs_int_tolerance_orig ;
       
   } elsif (/^\s*addenv\s+(\S+)\s+(\S.*\S)\s*$/) {
      # do a setenv for this variable.
      eval "\$ENV\{$1\} = \"\$ENV\{$1\}:$2\"" ;
      if($debug>1){
          print "eval \"\$ENV\{$1\} = \"\$ENV\{$1\}:$2\"\"\n" ;
          print "setenv $1 $ENV{$1}\n" ;
      }
   } elsif (/^\s*setenv\s+(\S+)\s+(\S.*\S)\s*$/) {
      # do a setenv for this variable.
      eval "\$ENV\{$1\} = \"$2\"" ;
      # XXXXXX enable automatically DO_QA=on when running qa_script for a 'qaprint' qa
      # This array will store qaprint status (enabled or not) depending on the QA number, to retrieve the information in email sending step
      if ($1 eq 'DO_QA' and $2 eq 'ON') {
        $include_file_name =~ /^or_QA.files_((\d)+).*$/ and do {
          my $qa_id = $1;
          push (@qaprint_qas_enabled,$qa_id) if (!grep(/^$qa_id$/,@qaprint_qas_enabled));
        };
      }
      # END XXXXXX

      if($debug>1){
          print "eval \"\$ENV\{$1\} = \"$2\"\"\n" ;
          print "setenv $1 $ENV{$1}\n" ;
      }
   } elsif (/^\s*setenv\s+(\S+)\s+(\S)\s*$/) {
      # see previous setenv above why two rules
      eval "\$ENV\{$1\} = \"$2\"" ;
      if($debug>1){
          print "eval \"\$ENV\{$1\} = \"$2\"\"\n" ;
          print "setenv $1 $ENV{$1}\n" ;
      }
       
   } elsif (/^\s*unsetenv\s+(\S+)\s*$/) {
      # do a unsetenv for this variable.
      if ( $ENV{$1} ) {
        delete $ENV{$1} ;
      }
      if($debug>1){
          print "unsetenv $1\n" ;
      }
   } elsif (/^\s*pushenv\s+(\S+)\s*$/) {
      # save and unsetenv this variable.
      my $vname = $1;
      my $value = "";

      if ( $vname ne "@" ) {
        if ( $ENV{$vname} ) { $value = $ENV{$vname};}
      }
      else { $value = "@";}
         
      push ( @envstack, $vname);
      push ( @envstack, $value);

      if($debug>1){
        print "pushenv $vname=$value\n" ;
        if ($debug>2){
          print "envstack = \n @envstack\n" ;
        }
      }

   } elsif (/^\s*popenv\s+(\S+)\s*$/) {
       # restore this variable.
       if (@envstack == 0) {
         if ($1 ne "@") {
           print STDERR ">>> Failed to popenv \"$1\" in file $cur_file_name. \nThe ENV stack(pushenv-ed) is empty.\n";
           exit ;
         } else {
           # popenv @
           if($debug>1){
             print "Skip \"popenv @\" in file $cur_file_name. \nThe ENV stack(pushenv-ed) is empty. \n" ;
             goto SKIP_POPENV;
           }
         }
       }

       my $value = pop( @envstack );
       my $vname = pop( @envstack );

       # check if the ENV name being popenv-ed matches with the pushed stack
       if ( $1 ne "@" ) {
         if ( $1 ne $vname ) {
           print STDERR ">>> Failed to popenv \"$1\" in file $cur_file_name. \nThe ENV variable at the top of the stack(pushenv-ed) is \"$vname\" \n";
           exit ;
         }
       }

       if($debug>1){
         if ( $1 eq "@" ) {
           print "popenv @ start\n" ;
         }
       }

       # handle ENV of first ($vname, $value) pair in stack
       if ( $value eq "" ) {
         delete $ENV{$vname} ;
         if($debug>1){
           print "unsetenv $vname\n" ;
         }
       } else {
         $ENV{$vname} = $value;
         if($debug>1){
             print "popenv $vname=$value\n" ;
         }
       }

       # handle rest ENVs if popenv @
       if ( $1 eq "@" ) {
         while (1) {
           if ( @envstack > 0 ) {
             $value = pop( @envstack );
             $vname = pop( @envstack );
             if ($vname ne "@") {
               if ( $value eq "" ) {
                 delete $ENV{$1} ;
                 if($debug>1){
                   print "unsetenv $vname\n" ;
                 }
               } else {
                 $ENV{$vname} = $value;
                 if($debug>1){
                     print "popenv $vname=$value\n" ;
                 }
               }
             } else {
               # $vname == @
               if($debug>1){
                 print "popenv @ end\n" ;
               }
               last;
             }
           } else {
             last;
           }

         }
       }

     SKIP_POPENV:       

     if ($debug>2){
       print "envstack = \n @envstack\n" ;
     }


   } elsif (/^\s*local\s+(\S+)\s+match\s*$/i) {
       if ( $fix_tolerances == 0 ) {
     $has_match = 1 ;
     push ( @match_local, $1 );
       }
       else {
           $out_buffer .= ">>> skipped: local $1  for test $full_test_id\n" ;
       }
       
   } elsif (/^\s*global\s+(\S+)\s+match\s*$/i) {
       $has_match = 1 ;
       push ( @match_global, $1 );
       
   } elsif (/^\s*local\s+(\S.*)\s*$/i) {
       if ( $fix_tolerances == 0 ) {
           $has_stack = 1 ;
           push ( @stack_local, $1 );
       }
       else {
           $out_buffer .= ">>> skipped: local $1  for test $full_test_id\n" ;
       }
       
   } elsif (/^\s*global\s+(\S.*)\s*$/i) {
       $has_stack = 1 ;
       push ( @stack_global, $1 );
       
   } elsif (/^\s*test\s+(\S*)/i) {
       $mark_label = $1 ;

       # XXXXXX Set specific QAPRINT limit number of line in extract file
       # For each new test we undefined a possible QAPRINT_LIMIT value (from an older one)
       # Take advantage of this feature to also unset QAKEY_SPECIFIC variable
       undef $ENV{'QAPRINT_LIMIT'};
       undef $ENV{'QAKEY_SPECIFIC'};
       # END XXXXXX

       # XXXXXX QA 14.0 with User Property (-dylib or RAD_USERLIB_LIBPATH environment variable)
       # For each new test we undefined a possible RAD_USERLIB_LIBPATH value (from an older one)
       undef $ENV{'RAD_USERLIB_LIBPATH'};
       # END XXXXXX      

       # XXXXXX Check ERRORS in screen_save (in addition to diff in ref.extract) + Check bounds (ignore diff in ref.extract)
       # For each new test we undefined a possible RESTRICT_CHECK_ERRORS_TO_FORRTL value (from an older one)
       undef $ENV{'RESTRICT_CHECK_ERRORS_TO_FORRTL'};
       # END XXXXXX

       undef $ENV{'DISABLE_GZ_UNCOMPRESS_INCLUDES'};

   } elsif (/^\s*then\s*$/i) {
       $within_else = 1;
       # execute to next line with 'else' or 'endif' in the file
       
   } elsif (/^\s*else\s*(if.*then)?\s*$/i) {
       &skip (1);
       # skip to next line with 'endif' in the file
       
   } elsif (/^\s*endif\s*$/i) {
       # do nothing - this line is just placeholder
       if ( $within_else == 0 ) {
     die ( "$cur_file_name: Endif not in if/then/else" ); }
       $within_else = 0;
     
   } elsif (/^\s*newid\s+([\d]+)\s*$/i) {
       if ( $within_else != 0 ) {
     die ( "$cur_file_name: Newid within if/then/else\n" ); }
       $tmp = $1;
       if ( $tmp > $test_id ) {
     $test_id = $tmp - 1;
     &start_test ;
       } elsif ( $tmp < $test_id ) {
     &out_file ( "      *** newid $1 out of sequence in $cur_file_name\n" ) ;
     &out_line ;
     die "      *** Aborting run !!! \n"  ;
       }
       
   } elsif (/^\s*require\s+(\S.*\S)\s*$/i ) {
       # skip the test if datafile not exists
       if ( ! -f $1  && !$running_double_check ) {
     $skip_becse_require = $1;
       }
   } elsif (/^\s*return\s+(\S.*\S)\s*$/i) {
       # skip the rest of file if datafile not exists
       if ( ! -f $1 ) {
     print ("-> terminate qa group - file $1 is missing\n") if $debug;
     last;
       }
   } elsif (/^\s*stop\s*/) {
      &out_file ( "      ***Stop command encountered in $cur_file_name\n" ) ;
      &out_line ;
      last;
   } elsif ( /^\s*keywords\s+(\S.*\S)\s*$/ ) {
       if ( $has_global_keywords ) {
     # spaces or commas are allowed as separators
     foreach $i (split(/[,\s]/,$1)) {
       push ( @local_keywords,$i ) if ($i) ;
     }
     #  print "Local keywords:" . join(':',@local_keywords) . " \n";
       }
   } elsif ( /^\s*keywords\s*$/) {
      &out_file ( "      ***Empty keywords line in $cur_file_name line $line_number\n" ) ;
   } else {
       $unknown_line = 1;
   }

   if ( $not_skipping == 0 ) {
       if ( /^go\s*/ ) {
     $num_runs_skipped++ ;
     $num_runs_attempted++ ;
     &start_test ;
       }
       next ;
   }
      
   if ( $num_no_license > 5 && $num_runs_good < 10 && $sanity_stop ) {
       &out_file (" Problems with licensing, Aborting QA. \n");
       &out_file (" ===================================== \n");
       $abort_reason = "Problems with licensing" ;
       $aborted_run = 1;
       goto ENDFILE;
   }

   if (/^\s*(fem|input|tcl)\s+(\S.*\S)\s*$/i ) {
      $fem_file = $2 ;
      $fem_file_path = dirname($fem_file);
      my @tmp=split('/',$fem_file);pop @tmp;
      my $input_path1=join('/',@tmp);
      $input_path1=~s/\/data$//;
      if ($input_path1) { $input_path = $input_path1 }
      $tests_infos{$full_test_id}{'Input_path'}=$input_path;
##### !!!!! dbg_stopqa_infos_extract
      $tmp_file_input = $fem_file;

   # XXXXXX Launch qa_script (starter+engine) when no engine is present in data folder (i is generated at starter time)
   # Check for special keyword inputfromstarter
      $fem_file_from_starter = 0;
   } 
   elsif ( /^\s*(inputfromstarter)\s+(\S.*\S)\s*$/i ) {
      $fem_file = $2 ;
      $fem_file_from_starter = 1;
   } 
   # XXXXXX END
   elsif ( /^keep_local_file/ ) {
        $clean_local_file = 0;
   } elsif (/^\s*copy\s+(\S.*\S)\s*$/i) {
      push (@to_copy , $1); # postpone till go
  
   } elsif (/^\s*listing\s+(\S.*\S)\s*$/i) {
      $listing_file=$1; 
 
   } elsif (/^\s*copyconst\s+(\S.*\S)\s*$/i) { # abused in PHLEX
      push (@to_copy , $1); # postpone till go
  
   } elsif (/^\s*extract\s+(\S.*\S)\s*$/i) {
      $original_extract_file = $1 ;
      $reference_extract_file = $original_extract_file;
      $reference_extract_file_name = basename($reference_extract_file);
##### !!!!! dbg_stopqa_infos_extract
      $tmp_file_extract = $original_extract_file;
      $base_extract_file = $original_extract_file; 
      if ($force_extract_overwrite && 
          $extract_suffix && 
          -f "$original_extract_file$extract_suffix") {
          push (@alternate_extract_file,$original_extract_file.$extract_suffix);
          $del_suffix_extract = 1;
      }elsif ( -f "$original_extract_file$extract_suffix" ) {
        $original_extract_file .= $extract_suffix;
      }
      $extract_file = $original_extract_file ;
      $extract_file =~ s/^.*\/// ;
      # &out_file (     "      extract file        = $original_extract_file\n" ) ;
   } elsif (/^\s*extract2\s+(\S.*\S)\s*$/i) {
      $t = $1 ; 
      push (@alternate_extract_file , $t) ;
      $have_extract2 ++;
      # &out_file (     "  alternate  extract file = @alternate_extract_file\n" ) ;
   } elsif (/^\s*h3dfiles\s+(\S.*\S)\s*$/i) {
      $t = $1 ; 
      @h3dfiles=split(/ /,$t);
      # &out_file (     "  h3dfiles  file = @h3dfiles\n" ) ;
   } elsif (/^\s*h3dextract\s+(\S.*\S)\s*$/i) {
      $t = $1 ; 
      $original_h3d_extract_file = $t ;
      $base_h3d_extract_file = $original_h3d_extract_file; 
      push (@h3d_extract_file , $t) ;
      # &out_file (     "  h3d extract file = @h3d_extract_file\n" ) ;
   } elsif (/^\s*h3dextract2\s+(\S.*\S)\s*$/i) {
      $t = $1 ; 
      push (@h3d_extract_file , $t) ;
      # &out_file (     "  h3d extract file = @h3d_extract_file\n" ) ;
   } elsif (/^\s*title\s+(\S.*\S)\s*$/i) {
       if ( $selfref_pass < 2 ) {
     $out_buffer .= "  *** $1\n" ;
       }
   } elsif (/^\s*print\s+(\S.*\S)\s*$/i) {
       $t = $1;
       $t =~ s/\$([a-zA-Z_][0-9a-zA-Z_]*)/$ENV{"$1"}/g ;
# Unescaped left brace in regex is deprecated, passed through in regex; marked by <-- HERE in m/\${ <-- HERE ([a-zA-Z_][0-9a-zA-Z_]*)}/ at ./qa_script line 1707.
# 1707      $t =~ s/\${([a-zA-Z_][0-9a-zA-Z_]*)}/$ENV{"$1"}/g ;
       $out_buffer .= "$t\n" ;

   } elsif (/^\s*debug\s+(\S.*\S)\s*$/i) {
       print "##DEBUG: $1 \n";
       
   } elsif (/^\s*file\s+(\S.*\S)\s*$/) {
       $fff = $1 ;
       push (@file_check, $fff);  # will be done after 'go'
       ($fname) = ($fff =~ /^(\S+)/) ;
       if ( -f $fname ) {  # remove it to avoid problems
     unlink $fname || die "**** !!!! can't remove $fname !!!!\n" ;
       }
       
   } elsif (/^\s*go\s+(\S.*\S)\s*$/i) {
       if ( $within_else != 0 ) { die ( "Go within if/then/else\n" ); }
       if ( $1 ) {
     $prog_args = $1;
       }
       &go (0) ;
       if ( $selfref_pass == 2 ) { next; }
       &start_test ;
   } elsif (/^\s*go\s*$/) {
       if ( $within_else != 0 ) { die ( "Go within if/then/else\n" ); }
       &go (0) ;
       if ( $selfref_pass == 2 ) { next; }
       if ( $num_runs_failed > 3 && ! $run_list && $sanity_stop ) {
# see if there is still hope :-)
       if ( ( $num_no_extract_created > 3 && $num_runs_good < 3 ) ||
      ( $num_crashes > 3 && $num_runs_good < 3 ) ||
      ( $num_crashes + $num_no_extract_created > 20 ) ||
      ( $num_runs_failed > 20 && $num_runs_failed > 2*$num_runs_good ) ){
     &out_file (" Too many failures, Aborting QA. \n");
     &out_file (" =============================== \n");
     $abort_reason = "Too many failures" ;
     $aborted_run = 1;
     goto ENDFILE;
       }
       }
       &start_test ;
   } elsif (/^\s*execute\s+(\S.*\S)\s*$/i) {
       if ( $1 ) {
     $prog_args = $1;
       }
       &go (1) ;
       $after_execute++; # disables run/no run decision;
   } elsif (/^\s*execute\s*$/) {
       &go (1) ;
       $after_execute++; # disables run/no run decision;
   } elsif (/^\s*return\s*$/i) {
       print ("-> terminate qa group\n") if $debug;
       goto ENDFILE;
   } elsif (/^\s*report_to\s+(\S.*\S)\s*$/i) {
       $tests_infos{$full_test_id}{'report_to'}=$1;
   } elsif (/^\s*local_timeout\s+([\d]+)\s*$/) {
       $xtra_args_test.= " --timeoutscript=$1 "
   } elsif ( $unknown_line ) {
      &out_file ( "      ***Unknown line in $cur_file_name: $_ \n" ) ;
   }

}

 ENDFILE:
#   If we were in the include file then ....
if ( $in_include > 0 ) {
    # reporting include stats
    if ( $quiet == 0 ) {
  &write_include_stats ( $cur_file_name );
    }
    close ( $infile );

    $infile = "TCLS";
    $cur_file_name = $qa_fem_files_file;
    $in_include = 0;
    $test_id = $main_test_id-1 ;
    # reset tolerances to the default from QA.const
    if ( ! $use_reset_tolerances ) {
  $diff_tolerance = $diff_tolerance_orig ;
  $warn_tolerance = $warn_tolerance_orig ;
  $zero_tolerance = $zero_tolerance_orig ;
  $scale_factor_delta_vs_emax = $scale_factor_delta_vs_emax_orig ;
  $scale_factor_emax = $scale_factor_emax_orig ;
  $abs_int_tolerance = $abs_int_tolerance_orig ;
  $rel_int_tolerance = $rel_int_tolerance_orig ;
    }
    &start_test ;
    if ( $fix_qa_files ) { close ( $fixfile ); }
    goto MAIN_LOOP ;

}

# Sorting test id must be done before the . and after !
sub test_sort {

    my ($A1,$A2,$B1,$B2);

    if ($a =~ /\./) {
      ($A1,$A2) = $a =~ /^(\d+)\.(\d+)$/; 
    }
    else {
      $A1=$a;
      $A2=0;
    }

    if ($b =~ /\./) {
      ($B1,$B2) = $b =~ /^(\d+)\.(\d+)$/; 
    }
    else {
      $B1=$b;
      $B2=0;
    }

    if ($A1 != $B1) {
      return $A1 <=> $B1;
    }
    else {
       return $A2 <=> $B2;
    }
}

#======================================================================
#======================================================================
#     GO SPOT, GO !!!
#======================================================================
#======================================================================
sub go {

# argument: 0 - normal run (from 'go' command), 1 - from execute command
# $after_execute 0 is normal, >=1 for consecutive execute within single example
    # this routine is divided into three parts:
    # 1 - executed only once at the first execute ($after_execute==0)
    # 2 - executed every time
    # 3 - executed only at the last entry (i.e. from go: $not_last_go==0)
    my ($not_last_go) = @_ ;
    my $tmp_time; 
    $exit_value  = 0 ;
    $signal_num  = 0 ;
    $dumped_core = 0 ;
    $nr_err = 0;  # 2 for reader error, 1 for serious difference detected
    #             # non-serious difference is ConstViol ITERATION

    # XXXXXX Check ERRORS in screen_save (in addition to diff in ref.extract) + Check bounds (ignore diff in ref.extract)
    # Reset variable when starting a run in several passes
    # If an error has already been found, skipping this run
    $found_error = -1 if ($selfref_pass == 1);
    if ($found_error > -1) {
          # print "SKIPPING RUN, ERROR FOUND \n"; 
          goto FOUND_ERROR;
    }
    # END XXXXXX

    ($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst) =
  localtime(time);
    if ( ! -f $fem_file && -f "$fem_file".".gz" ) {
  $extra_gz = "(.gz)" ;
    } else {
  $extra_gz = "" ;
    }

    # This decides if this particular example is to be executed
    if ( $qa_skip_list =~ /\W$dot_test_id\W/ ) {
  &out_file (" -- $full_test_id on skip list\n") ;
  goto SKIP; }
    if ( $skip_this_multi_test || &do_we_run ) { goto SKIP; }
    if ($input_check_script) {
      system("perl $input_check_script $input_path $full_test_id");
      if (-f "_skip_this_test") {
        qx (rm -f _skip_this_test); 
        $not_skipping=0;  
      }
    }
    if ($not_last_go == 1 and $echo_radioss == 1) {
      my @tmp_tab=split('/',$fem_file);
      pop @tmp_tab;
      my $test_path=join('/',@tmp_tab);
      $test_path=~s/\/$//;
      $test_path=~s/\/data$//;
      if ($test_name_requested) {
        if (not $test_path eq "$test_name_requested")  { goto SKIP; }
      }
      if ($test_path_requested) {
        if (index($test_path,$test_path_requested) < 0) { goto SKIP; }
      }
      if (($force_echo == 1 and $after_execute == 0) or $tests_titles and ( $selfref_pass <= 1 )) {
        if ($sensitivity == 0 or $sensitivity_cur_n == 0) {
        printf STDOUT "TEST %5s : $test_path\n",$full_test_id;}
        else {
        $out_buffer .= sprintf("TEST %5s : $test_path\n",$full_test_id);}
      }
    }
    if ( $skip_tests ) { goto SKIP ; }
    if ( $after_execute ) {
  $out_buffer .= sprintf("   _%d   %s%s\n", $after_execute,
             $fem_file, $extra_gz);
    } elsif ( $selfref_pass == 2 ) {
  $out_buffer .= sprintf("   _pass_2 %s%s\n",
             $fem_file, $extra_gz);
    } else {
        $out_buffer .= sprintf("%5s $FEM file %3s (%2d:%02d:%02d) = %s%s\n",
# printf("%5s $FEM file %3s (%2d:%02d:%02d) = %s%s\n",
             $full_test_id, $mark_label, $hour, $min,
             $sec, $fem_file, $extra_gz);
    }
    &out_file ("$out_buffer") ;
    $out_buffer = "" ;

    # XXXXXX using attached ref files in tracking email (same as for QAPRINT)
    # XXXXXX (QAPRINT QA email sending) : as the HTML email is not very usable as is (many value, html errors)
    # we want to keep the ref.extract files (both reference and run) to send them by email
    # At the first test run we copy the original ref.extract file
    if ( (defined $ENV{'DO_QA'} and $ENV{'DO_QA'} eq 'ON') or defined $extract_from_starter ) {

      print "\n/!\\ QAPRINT is enabled (DO_QA=ON into your environment), it should be used with care on some specific QA only /!\\\n\n" if (defined $ENV{'DO_QA'} and $ENV{'DO_QA'} eq 'ON');

      if (! defined($test_already_run{$full_test_id})) {

        if (!scalar(keys %test_already_run)) {  
          # We empty/create the tree at the very first test run occurrence
          # print "TRACE Emptying folder $copy_extract_path_4_tracking\n";
          system("mkdir -p $copy_extract_path_4_tracking");      
        }

        if (-f $reference_extract_file) {
          system("cp -p $reference_extract_file  $copy_extract_path_4_tracking/".$full_test_id."_$reference_extract_file_name");
          $test_already_run{$full_test_id} = 1;
        }
      }
    }

#
#  ============================================================
#  here we have a real GO - print buffer in verbose mode to have feedback
#  ============================================================
#
    # 1 - executed only once at the first execute (or single go)
    if ( $after_execute==0 ) {
      # has to be done before copy commands
#      @all_root_cleanup=();
      &cleanup_run_files ;
      @all_root_cleanup=();
    }

    &do_copy_commands;
    if ( $force_fail ) {
# fail to exec copy command in the or_QA.files_...
  $failtype ="serious_1";
  goto SERIOUS_FAILURE ;
    }
    
    if ( $verbose ) {
  &out_file( "$out_buffer" ) ;
  $out_buffer = "" ;
    }

    # 1 - executed only once at the first execute (or single go)
    if ( $after_execute==0 ) {
  
        #  here we add an failure type indicator  
  $failtype ="pass";
  
  $speedgrp = lc(substr($mark_label,0,1));
  $testgrp = substr($mark_label,1);
  $run_test_id= $full_test_id;
  $run_test_id =~ s/\./_/;
  if ($nightlyqa !=0) {
      print DINFO "\$test$run_test_id\{speedgrp\}=q($speedgrp);\n";
      print DINFO "\$test$run_test_id\{testgrp\}=q($testgrp);\n";
      print DINFO "\$test$run_test_id\{filename\}=q($fem_file);\n";
      print DINFO "\$testall{q($full_test_id)}=\\%test$run_test_id;\n";
  }

  $zero_fail = 0 ;
  $rel_fail = 0 ;
  $num_diffs = 0 ;
  $serious_failure = 0 ;

  $num_runs_attempted++ ; 

  # leave a trace which example is executed
  open ( RUNID, "> $run_id_file" );
  print  RUNID "$full_test_id $mark_label $fem_file\n" ;
  close  RUNID ;

  if (-f $local_run_extract) {
      $out_buffer .=
    "      **File `$local_run_extract' already exists. Unlinking.\n" ;
      unlink ($local_run_extract) || warn "$!" ;
  }

    }

#----------------------------------------------------------------------
    # 2 - executed every time
    #  prepare before exec calling
 
#
# check for existence of the main file, abort if absent
#
    if (! $fem_file) {
        warn "      $fem_file file name is not defined!  Aborting the test!\n" ;
        $out_buffer .= "\n  ===============>>> $full_test_id: QA test failed.\n" ;
        $failtype ="serious_2";
        goto SERIOUS_FAILURE ;
    }

    # XXXXXX Launch qa_script (starter+engine) when no engine is present in data folder (i is generated at starter time)
    # If the special keyword inputfromstarter has been used, we don't check for file existence
    if ($fem_file_from_starter) {
      $Run_file = $fem_file;
      $Run_file =~ s/^.*\/// ;   # strip path: delete everything up to '/'
    }
    # XXXXXX END
    else {
        # create local file names:
        #   $Run_file = actual file in local directory
        #   $root     = same without any extension
        # from input data:
        #   $fem_file       - coming from or_QA.files
        #   $local_fem_file - fixed, possibly empty

        if ( $local_fem_file ) {
      # $root and $Run_file are fixed but we may need to preserve extension
        } else {
      $Run_file =  $fem_file ;
      $Run_file =~ s/^.*\/// ;   # strip path: delete everything up to '/'
      $root     =  $Run_file ;
      $root     =~ s/\.([^.])*$// ; # strip any extension if exists
      $root     =~ s/D0[0-9]$// ;   # strip radioss extension
      $root     =~ s/_000[0-9]$// ;
      push @all_root_cleanup,$root;
        }
        if ( $add_missing_extract ) {
      push(@p4_local_files, $fem_file);
        }
        
        # we need to copy input file to local folder (or scream if can't do it)
        # this sleep is for network NFS troubles (notorious on origin4)
        if (! -f $fem_file) {
      sleep 5 ;
      if (! -f $fem_file) {
          sleep 5 ;
      }
        }
        
        if ( !-f $fem_file && -f $fem_file . ".gz" ) {
      $fem_file .= ".gz" ;
        }
        # get extension to Run_file
        if ( -f $Run_file and $clean_local_file) { # in multirun examples this may cause copy problems
      &munlink ( $Run_file );
        }
        if ( substr($Run_file,-4) eq ".EXT" ) {
      $Ext = $fem_file;
      $Ext =~ s/^.*\/// ; # strip path: delete everything up to '/'
      $Ext =~ s/\.gz$// ; # strip trailing .gz if present
      $Ext =~ s/^.*\.// ; # strip everything till last dot
      $Run_file = $root . "." . $Ext;
        }
      
        if (-f $fem_file) {
      if ( $look_for_gz eq substr($fem_file,-3) ) {
           # $out_buffer .= "                            unzipping FEM file\n"; 
          system ("gzip -df < $fem_file > $Run_file") ;
          $fem_file = substr($fem_file,0,-3);
          &delete ($Run_file) ;
          $fem_is_zipped = 1;
      } else {
          $fem_is_zipped = 0;
          &copy ($fem_file, $Run_file) ;
          if ( $force_fail ) {
        $failtype ="serious_3";
        goto SERIOUS_FAILURE ;
          }
      }
        }  else {
      $out_buffer .= "      $fem_file does not exist!  Aborting the test\n";
      $failtype ="serious_4";
      goto SERIOUS_FAILURE ;
        }

    }

# Get the date
   $date = localtime ;


# ******************************************************************
# ****************       E X E C       *****************************
# ******************************************************************
    if($check_newfile){
      system "touch .each-qa-start";
      sleep(1); 
    }

    $suppress_args        = 0; # allow run without --args part
    if ( $prog_args =~ /^override\b/i ) {
  $suppress_args = 1 ;
  $prog_args =~ s/^override\s*// ;
    }
    if ( $suppress_args == 0 && $user_prog_args ne "" ) {
  $prog_args = $user_prog_args . " " . $prog_args;
    }
    if ( $force_echo > 0 ) {
  $prog_args .= " -out" ;
    }
    if ( $force_echo < 0 ) {
  $prog_args .= " -log" ;
    }
#    if ( $prog_args  ) {
#        $out_buffer .= "        Program argument(s) set to: $prog_args\n" ;
#    }
# Print out the env for debugging
    if($debug>2){
        print "---Enviroment variables before run---\n";
        foreach $key (sort(keys %ENV)) {
             print "$key = $ENV{$key}\n";
        }
    }

# Print out the files for debugging
    if($debug>3){
      opendir(CDIR, '.') or die $!;
        print "---Files in qa dir before run---\n";
      while ($cdirfile = readdir(CDIR)) {
      print "$cdirfile \n";
    }
      closedir(CDIR);
    }



#
# Run the executable using debugger
# =================================
#

   ($usercpu, $systemcpu, $cusercpub4, $csystemcpu4) = times;
   $timeb4 = time ;
    my $cputimchild = 0;

    $xtra_args = "";

    if ( $selfref_pass ) {
        $xtra_args = "-pass$selfref_pass $selfreference" ; 
    }
    if ( $xtra_args_add ) {
        $xtra_args.=" $xtra_args_add";
    }

    # XXXXXX integrate solver run manager in RD QA
    # Add hwsolver argument in xtra_args to inform or_radioss.pl we want to use the hwsolver script to run binaries (one pass)
    if ($hwsolvermanager) {
      $xtra_args.=" -hwsolvermanager_1pass";
      $xtra_args.=" -hwsolvermanager_args='".$hwsolvermanager_args."'" if (defined $hwsolvermanager_args and $hwsolvermanager_args ne '');
    }

    #OSSPECIFIC
    if ( $echo_test ) {
  system ("$winefront $here$local_executable $Run_file $prog_args".
    " -compressnone"
    . "> $qa_screen 2>&1 ") ;
  $tmp = substr ($?,0,1) ;
  if ( $tmp ge "0" && $tmp le "9" ) {
      $exit_value  = $? >> 8;
  } else {
      $exit_value  = 0;
  }
  unlink $Run_file ;
  unlink $local_run_extract ;
  if ( $exit_value ) {
      # if echo creation run failed 
      unlink "run.echo";
      goto SKIP;
  }
  system ("cp", "run.echo", $Run_file ) ;
    }

    if ( $translator ) {
  if ( $platform eq "NT" ) {
      system ( "$translator", "$Run_file" );
  } else {
      system ( "./$translator", "$Run_file" );
  }
  $Run_file .= "_tra" ;
  &delete ($Run_file) ;
    }


    # Passing the test id and path to or_radioss.pl script
    $xtra_args .= " --fem_file_path=$fem_file_path";
    $xtra_args .= " --full_test_id=$full_test_id" if ($xtra_args !~ /\-\-full_test_id/);
    # XXXXXX QA ERRORS and WARNINGS
    $xtra_args .= " $extract_from_starter" if (defined $extract_from_starter);
    # END XXXXXX

    # XXXXXX Check ERRORS in screen_save (in addition to diff in ref.extract) + Check bounds (ignore diff in ref.extract)
    # Pass the ignore_check_errors option to or_radioss.pl
    $xtra_args .= " --ignore_check_errors=$ignore_check_errors";
    # END XXXXXX


   if ( $run_debugger && ! $exec_script ) {

       for my $elem (values %env_vars_orig) {
            die "ERROR: some environment variable includes \@\@CURRENT_CL\@\@ pattern, which cannot be substituted here, please replace it with a correct CL" if ($elem =~ /\@\@CURRENT_CL\@\@/); 
       }

       if ( index($run_debugger,"<")<2 ) {
     print "\nStarting $debugger_command debugger\n" ;
     print "Type: run $Run_file $prog_args $xtra_args\n\n" ;
       }
       system ("$debugger_command $here$local_executable") ;
       
       if ( -f "run.dump" ) {
     $num_bootstrap_tests ++;
     print "\nStarting $debugger_command for bootstrap run\n" ;
     $tmp = "-bootstrap run.dump -outfile=run";
     print "Type: run $tmp $prog_args\n\n" ;
     system ("$debugger_command $here$local_executable") ;
       }
       system ("touch $qa_screen") ;

   } elsif ( $run_debugger && $exec_script ) {
       
       print "\n############################################################################\n";
       print   "##                                                                        ##\n";
       print   "##                       !!! DEBUGGER MODE ENABLED !!!                    ##\n";
       print   "##                  This may happen when option is badly used             ##\n";
       print   "##                         (e.g. -env instead of --env)                   ##\n";
       print   "##                                                                        ##\n";
       print   "############################################################################\n\n";
       sleep 2;

       for my $elem (values %env_vars_orig) {
            die "ERROR: some environment variable includes \@\@CURRENT_CL\@\@ pattern, which cannot be substituted here, please replace it with a correct CL" if ($elem =~ /\@\@CURRENT_CL\@\@/); 
       }

       $ENV{'SCRITPDEBUG'}="ON"; 
       system ( "$^X $exec_script $runmpiqa $local_executable $exec_script_args $Run_file $prog_args $xtra_args" );
       delete $ENV{'SCRITPDEBUG'}; 
   } 
   else {
   
      #
      # Run the executable
      # ==================
      #

        $timult = 0;
        if ( $timeout ) {
          $timult = $timeout ;
          $n = lc(substr($mark_label,0,1));
          if ( $n gt "c" ) { $timult = 2*$timult; }
          if ( $n gt "d" ) { $timult = 0; }
          if ( $testgrp =~ /[gm]/) {
              print "Disabling timeout for g and m group\n" ;
              $timult = 0;
          }
        }

        if ($exec_script eq "or_radioss.pl") {

          if ($prog_args) {
              #print "WARNING : prog_args=$prog_args for this test\n" ;
              if ($prog_args =~ /-np=1/) {
                 print "          !!! WARNING SMP LIMITATION !!! (forced to -np=1 in QA.file)\n" ;
              }
              if ($prog_args =~ /-nt=1/) {
                 print "          !!! WARNING 1 THREAD LIMITATION !!! (forced to -nt=1 in QA.file)\n" ;
              }
          }

        }

        if ($listing_file) { $prog_args.=" --listing $listing_file"; }
        &delete ($qa_screen) ;
        if ($sensitivity == 1 and $no_random == 0 and $prog_args =~ /-starter/) { 
           my $rseed = $sensitivity_cur_n/$sensitivity_n;
           $xtra_args .=" --postargs -rxalea $sensitivity_xalea -rseed $rseed";
        }
        if ( $use_stdout ) { open($fh,">&STDOUT"); }
        else { open($fh,">$qa_screen"); }
        if ( $exec_script ) {

          my $currentCL;
          my $tracker_changelist;
          # Getting the current changelist
          if (! scalar(@changelists)) {
            $currentCL = (split('/',$executable))[-2];
          }
          # If we are tracking
          else {
            $currentCL = $changelists[-1]; # In case of tracking, currentCL is the last element
            $tracker_changelist = $changelists[$changelist_current];
          }

          my %env_vars_to_expand;
          print " ============================== PASS $selfref_pass ==========================\n";
          # print " === executable : $executable\n";
          # print Dumper @changelists;
          # print " === currentCL : $currentCL\n" if (defined $currentCL);
          # print " === tracker_changelist : $tracker_changelist\n" if (defined $tracker_changelist);

          # If PASS=1
          if ($selfref_pass == 1) {
            # If some env var contain @@CURRENT_CL@@, happen for pon, chkpt, ... we also have 2 passes
            # For each env var
            while (my ($env_var_name, $env_var_value) = each %env_vars_orig) {
              chomp $env_var_value;
             
              # If some env var contain @@CURRENT_CL@@
              if ($env_var_value =~ /\@\@CURRENT_CL\@\@/) {
               
                # If tracking is enabled
                if (defined $tracker_changelist) {
                  ($env_vars_to_expand{$env_var_name} = $env_var_value) =~ s/\@\@CURRENT_CL\@\@/$tracker_changelist/;
                }

                # Else (no tracking)
                else {
                  ($env_vars_to_expand{$env_var_name} = $env_var_value) =~ s/\@\@CURRENT_CL\@\@/$currentCL/;                  
                }
              }
            }

            # Checking if we have rev_env_XXX, if yes we overwrite the variable with it
            for my $elem (@selfreference_args_ref_env) {
              $elem =~ /^-ref_env_([^=]*)=(.*)$/ and do {
                my $env_var_name = $1;
                my $env_var_value = $2;
                $env_vars_to_expand{$env_var_name} = $env_var_value; # We overwrite with wanted value
              };
            }

          }
          else { # PASS 0 ou 2

            # For each env var
            while (my ($env_var_name, $env_var_value) = each %env_vars_orig) {
              chomp $env_var_value;
             
              # If some env var contain @@CURRENT_CL@@
              if ($env_var_value =~ /\@\@CURRENT_CL\@\@/) {
               
                # If tracking is enabled
                if (defined $tracker_changelist) {
                  ($env_vars_to_expand{$env_var_name} = $env_var_value) =~ s/\@\@CURRENT_CL\@\@/$tracker_changelist/;
                }

                # Else (no tracking)
                else {
                  ($env_vars_to_expand{$env_var_name} = $env_var_value) =~ s/\@\@CURRENT_CL\@\@/$currentCL/;                  
                }
              }

              # Else (no @@CURRENT_CL@@)
              else {
               
                # If tracking is enabled
                if (defined $tracker_changelist) {
                  ($env_vars_to_expand{$env_var_name} = $env_var_value) =~ s/$currentCL/$tracker_changelist/;
                }

                # Else (no tracking)
                else {
                  $env_vars_to_expand{$env_var_name} = $env_var_value;
                }
              }
            }
          }

          # We set each env var from the hash
          for my $key (sort keys %env_vars_to_expand) {
            chomp $env_vars_to_expand{$key};

            # Setting modified value in environment variable              
            print "-- Setting environment variable : $key => $env_vars_to_expand{$key}\n";
            $ENV{$key} = $env_vars_to_expand{$key};
          }

          # print "#######################################\n";
          # print "## exec_script:$exec_script\n";
          # print "## runmpiqa:$runmpiqa\n";
          # print "## local_executable:$local_executable\n";
          # print "## exec_script_args:$exec_script_args\n";
          # print "## Run_file:$Run_file\n";
          # print "## prog_args:$prog_args\n";
          # print "## xtra_args:$xtra_args\n";
          # print "## xtra_args_test:$xtra_args_test\n";
          # print "## last_go:$not_last_go\n";
          # print "## QAPRINTLIMIT : ".$ENV{'QAPRINT_LIMIT'}."\n";
          # print "## QAKEY_SPECIFIC : ".$ENV{'QAKEY_SPECIFIC'}."\n";
          # print "## RAD_USERLIB_LIBPATH : ".$ENV{'RAD_USERLIB_LIBPATH'}."\n";
          # print "## RESTRICT_CHECK_ERRORS_TO_FORRTL : ".$ENV{'RESTRICT_CHECK_ERRORS_TO_FORRTL'}."\n";
          # print "#######################################\n";

          if ( $debug ) { print $fh "$^X $perldebug $exec_script $runmpiqa $local_executable $exec_script_args $Run_file $prog_args $xtra_args $xtra_args_test last_go=$not_last_go\n";}
          &mesystem ($timult, "$^X $perldebug $exec_script $runmpiqa $local_executable $exec_script_args $Run_file $prog_args $xtra_args $xtra_args_test last_go=$not_last_go",$fh);
        } 
        else {
            if ( $debug ) { print $fh "$winefront $here$local_executable $Run_file $prog_args $xtra_args $xtra_args_test last_go=$not_last_go\n";}
            &mesystem ($timult,"$winefront $here$local_executable $Run_file $prog_args $xtra_args $xtra_args_test last_go=$not_last_go",$fh) ;
        }
        close($fh);
        if ( -f "run.dump" ) {
          $num_bootstrap_tests ++;
          $tmp = "-bootstrap run.dump -outfile=run";
          if ( $use_stdout ) {
              if ( $debug ) { print "$winefront $here$local_executable $tmp $prog_args $xtra_args_test last_go=$not_last_go\n";}
              &mesystem ($timult,"$winefront $here$local_executable $tmp $prog_args $xtra_args_test last_go=$not_last_go",$fh);
          } 
          else {
              if ( $debug ) { print "$winefront $here$local_executable $tmp $prog_args $xtra_args_test last_go=$not_last_go >> $qa_screen 2>&1 \n" ;}
              open($fh,">>$qa_screen");
              &mesystem ($timult,"$winefront $here$local_executable $tmp $prog_args $xtra_args_test last_go=$not_last_go",$fh) ;
              close($fh)
          }
        }


   }

   # time stats 
   ($usercpu, $systemcpu, $cusercpu, $csystemcpu) = times;
###    print ("Times: $usercpu, $systemcpu, $cusercpu, $csystemcpu\n");
   $ctim = ($cusercpu+$csystemcpu+$cputimchild-$cusercpub4-$csystemcpu4); 
   $ctim_fmt = &format_time_1($ctim);
   $wtim = ( time - $timeb4 ); 
   $wtim_fmt = &format_time($wtim);

   $out_buffer .= "      done: <userCPU= $ctim_fmt, wall= $wtim_fmt>\n" ;
    if ( $wtim > $longest_time ) {
  $longest_time = $wtim;
  $longest_time_fmt = $wtim_fmt;
  $longest_test = "$full_test_id" ;
    }

#----------------------------------------------------------------------
# after exec we process file commands, and clean for next 'execute' or 'go'
#----------------------------------------------------------------------
    $prog_args = "";
    
    if ( &do_file_commands ()  ) {
  $failtype ="serious_12";
  $serious_failure = 1;
    }

    if ( $doslines != 0 ) {
  $tmp = &check_ascii ;
  if ( $tmp ) {
      $failtype ="serious_12";
      $serious_failure = 1;
  }
    }
    if ( &search_4_nan ) {
  $failtype ="serious_15";
  $serious_failure = 1;
    }
    

    # XXXXXX Check ERRORS in screen_save (in addition to diff in ref.extract) + Check bounds (ignore diff in ref.extract)
    # If the extract file contains a FOUND_ERROR, then exit the run stage
    # Store the # of screen save in FOUND_ERROR variable
    if (! $ignore_check_errors) {
        if (-f "RD-qa.extract") {
            $found_error = `grep "FOUND_ERROR" RD-qa.extract | awk '{print \$3}'`;
            chomp $found_error;
            if ($found_error !~ /^\d+$/) { $found_error = -1; }
            # print "TRACE FOUND ERROR IS $found_error ------\n";
        }

        if ($found_error > -1) {
              $failtype ="serious_15";
              $serious_failure = 1; 

            if (! defined($test_already_run_check_error{$full_test_id})) {
                if (!scalar(keys %test_already_run_check_error)) {  
                  # We empty/create the tree at the very first test run occurrence
                  system("mkdir -p $check_error_path_4_tracking");      
                }
            } 

            # If create/overwrite extract/reference is asked, we disable it
            $create_ref = 0;
            $add_missing_extract = 0;
            $force_extract_overwrite = 0;
        }
    }
    # print "==== TRACE FAILURE SERIOUS IS $serious_failure\n";

    # Tag to skip run when error found previously
    FOUND_ERROR:
    # END XXXXXX

#----------------------------------------------------------------------
    # 3 - executed only at the last entry (i.e. from go: $not_last_go==0)

    # This is return from 'execute' command
    if ( $not_last_go ) { return ; } 
#----------------------------------------------------------------------

    if($keep_results and -f ".test-start"){
      &check_new_files(".test-start",$full_test_id);
    }

    # XXXXXX Check ERRORS in screen_save (in addition to diff in ref.extract) + Check bounds (ignore diff in ref.extract)
    # If error is not present in extract file and ignore_extract_comparison is used then ignore all comparison set the test as passed
    if ($ignore_extract_comparison and $found_error == -1) {
        #        
        #     QA test passed
        #    
        print "\n /!\\ Ignoring extract file comparison (no error found) /!\\\n\n";
        $num_runs_good++ ;
        if ( $run_err_list ) { $list_of_good .= " $full_test_id" ; }
        if ( $verbose ) {
          &out_file ( $out_buffer );
        }
        if($use_which_extract==1 && $del_suffix_extract==1) {
         system ("git rm $base_extract_file$extract_suffix");
         $git_deleted .= " $base_extract_file$extract_suffix";
        }
        my $failure_key="$full_test_id";
        #     update test status if requested
        if ($noretrack) {
        if (exists $failures{$failure_key}) {
          if ($failures{$failure_key}{'Status_flag'} <= 0) {
            $failures{$failure_key}{'Status_flag'}=$time;
            $failures{$failure_key}{'Status_flag_date'}=strftime("%d %B %Y  %H:%M", localtime($failures{$failure_key}{'Status_flag'}));
            $failures{$failure_key}{'Old_issue'}=0;
            $failures{$failure_key}{'Extract_fixed'}=join('',@{$tests_infos{$failure_key}{'Extract'}});}
            $failures{$failure_key}{'Changelist_fixed'}=$changelists[$changelist_current];
            # Empty stdout_errors to avoid getting error text in Solved emails
            $failures{$failure_key}{'Stdout_errors'}='';
          }
        }


    }
    # Else do a std comparison
    else {
    # END XXXXXX

        if ( $selfref_pass != 0 ) {
            #   print "SELF pass $selfref_pass\n" ;
            if ( $selfref_pass == 1 ) {
              seek ( $infile, $file_location, 0 );
              $selfref_pass = 2;
              $after_execute = 0;
              $xtra_args_test       ="";
              if ( -f $pass1extract ) { unlink $pass1extract ; }
              rename ( $local_run_extract, $pass1extract ) ;
              return;
            }
            $extract_file =           $pass2extract ;
            $original_extract_file =  $pass1extract ;
            @alternate_extract_file = ();
            $selfref_pass = 1;
            &delete( $pass1extract );
        }

    # Echo if setup differs from tolerances
       if ( $diff_tolerance != $diff_tolerance_orig ) {
           $out_buffer .= "        Diff Tolerance    = $diff_tolerance\n" ;
       }
       if ( $zero_tolerance != $zero_tolerance_orig ) {
           $out_buffer .= "        Zero Tolerance    = $zero_tolerance\n" ;
       }

    #
    # Check and see if an extract file name was specified
    #
        $no_original_extract_file = 0 ;
        if (! $extract_file) {
      $temp = $fem_file ;
      $temp =~ s;\.[^./\\]+;.extract; ;
      $original_extract_file = $temp ;
      $extract_file = $root . ".extract" ;
      $base_extract_file = $original_extract_file ;
    # $out_buffer .= "      **No extract file defined !!  Assuming file name : $original_extract_file\n\n"  ;
      if ( ! -f $original_extract_file ) {
          $no_original_extract_file = 1 ; }
        }

    #
    # Check and see if the extract file is already here
    #
        if (-f $extract_file) {
      $out_buffer .= "      **File `$extract_file' already exists.  Unlinking ...\n" ;
      unlink ($extract_file) || warn "$!" ;
        }

    #
    # For a .parm file format we must move the run.extract file to $extract_file
    # We also need to the remove run.parm file so we don't get problems later
    #
        if ( -f $local_run_extract ) {
      if ( ! rename $local_run_extract, $extract_file ){
          $out_buffer .= "Er1";
          if ( ! system ("mv", $local_run_extract, $extract_file ) ) {
        $out_buffer .= "Er2";
          }
      }
        } else {
          # $out_buffer .= "Er0";
        }

    #
    # Check and see if the original extract file existed 
    #
       if (! -f $original_extract_file){
           if ( $add_missing_extract == 0 ) {
         $out_buffer .= "      **Specified extract file $original_extract_file does not exist!!\n\n" ;
           } else {
         $out_buffer .= "      **Creating new reference extract file $original_extract_file\n" ;
           }
          $no_original_extract_file = 1 ;
       }

        
       if (! -f $extract_file) {
          $num_no_extract_created ++;
          if ( $add_missing_extract == 0 ) {
          $out_buffer .= "      **New extract file $extract_file file wasn't created?\n" ;
          }
          $failtype ="serious_6";
          goto SERIOUS_FAILURE ;
       }
    #   save sensitivity extract files
       if ($sensitivity == 1) {
    #      &preserve_1_file ($extract_file, $s_dir, $sensitivity_cur_n, $root) ;
         &copy ( $extract_file, $full_test_id."_".$extract_file."_".$sensitivity_cur_n, 1 ,1);
       }

       &delete ($extract_file) ;

    RESET_EXTRACT:
        $diff_buffer = "";
       if (! $no_original_extract_file) {

          if ( ! open (ORIG_EXTRACT, "< $original_extract_file") ) {
        $out_buffer .= "   $! $original_extract_file\n" ;
        $failtype ="serious_7";
        goto SERIOUS_FAILURE ;
          }
          if ( $required_example ne "" ) {
        $out_buffer .= "      Trying extract: $original_extract_file\n";
          }
          
          # check if to skip this test     
          open (NEW_EXTRACT, "< $extract_file") || die "$! $extract_file" ;
          while (<NEW_EXTRACT>) {
              if (  /.*QASKIP.*/ ) {
            close (NEW_EXTRACT);
                  goto SKIP;
              } 
          }
          close (NEW_EXTRACT);

          if ( $serious_failure != 0 ) {
        goto SERIOUS_FAILURE ;
          }
          
          open (NEW_EXTRACT, "< $extract_file") || die "$! $extract_file" ;

          # print "-- COMPARING $original_extract_file to $extract_file\n";

          # ============ Start comparing both extract files =========
          # Assumptions made :
          # Both files are in the proper format.
          # Both files have the same number of lines (modified)
          # Both files have the variables in the same order.

          $noerrqa   = 1;

          # Getting scale (emax) and energy reference from the ref.extract file
          if (! $no_check_emax) {
            if (-f $reference_extract_file) {
              undef %extract_ref_values;
              open (REF_EXTRACT, "<$reference_extract_file");
              @ref_extract=<REF_EXTRACT>;
              close(REF_EXTRACT);
              chomp @ref_extract;

              my $loc_max_nrj; # This is a way to get the max nrj value when 2nd column (emax) is not defined
              foreach my $elem (@ref_extract) {
                chomp $elem;
                (my $loc_number,$loc_variable, $loc_value, $loc_scale) = &get_extract_line($elem);
                $loc_value =~ s/\s*$//;
                $extract_ref_values{$loc_variable} = $loc_value;
                if ( ($loc_variable eq 'IENERGY' or $loc_variable eq 'KENERGYT' or $loc_variable eq 'KENERGYR' or $loc_variable eq 'EXTWORK') and ! defined $extract_ref_values{'emax'}) {
                  if ($loc_scale) {
                    print " ---- Getting emax from 2nd column: $loc_scale\n" if ($dbgout);
                     $extract_ref_values{'emax'} = $loc_scale; 
                  }
                  else {
                    if (! defined $loc_max_nrj or ($loc_max_nrj < $loc_value)) {
                      print " ---- Getting emax from max value : $loc_value\n" if ($dbgout);
                      $loc_max_nrj = $loc_value;
                    }
                  }
                }
              }
              if (! defined $extract_ref_values{'emax'} and defined $loc_max_nrj) {
                $extract_ref_values{'emax'} = $loc_max_nrj;
                $scale = $extract_ref_values{'emax'}; # Not sure it is used any more ...
              }
              print " ---- EMAX is $extract_ref_values{'emax'}\n" if ($dbgout);
              if (defined $extract_ref_values{'emax'}) { $emax_by_test_id{$full_test_id} = $extract_ref_values{'emax'}; }
              else { $emax_by_test_id{$full_test_id} = 'undef'; }
            }
            else {
              print "      **Specified extract file $reference_extract_file does not exist!!\n\n" ;
            }
            if ($dbgout) {
              print "-------------------\%extract_ref_values-------------------\n";
              print Dumper %extract_ref_values;
              print "--------------------------------------\n";
              # exit;
            }
          }

          $orig_line = <ORIG_EXTRACT>;
          $new_line  = <NEW_EXTRACT>;
    ##### !!!!! dbg_stopqa_infos_extract
          my $org_ext_tmp= $orig_line;   
          my $new_ext_tmp= $new_line;  

          while (($orig_line) || ($new_line)) {

       if ( $usecqaext == 1 && $skipfmt ) {
           # Skip lines which are expected to be absent
           if (($orig_line)) {
           while ( $orig_line =~ /^\s*(\d+)\s+${skipfmt}(\S*)\s+(\S+)\s*$/ ) {
         $orig_line = <ORIG_EXTRACT>;
         if ( $orig_line ) {
             chomp ($orig_line) ;
         } else {
             last;
         }
           }
           }

           if (($new_line)) {
           while( $new_line =~ /^\s*(\d+)\s+${skipfmt}(\S*)\s+(\S+)\s*$/ ) {
         $new_line = <NEW_EXTRACT>;
         if ( $new_line ) {
             chomp ($new_line) ;
         } else {
             last;
         }
           }
           }
             }
           if ( !($orig_line) || !($new_line)) { 
           # one of the files is longer than other
         last; 
           }

             chomp ($orig_line) ;
             chomp ($new_line) ;

        if ($dbgout) {
            print "\n#################################################################\n";
            print" original line: $orig_line (file is $original_extract_file)\n";
            print" new      line: $new_line (file is $extract_file)\n";
        }

        my $new_scale; # not use just here to avoid warning
        my $orig_scale; # not use just here to avoid warning
        ($orig_number,$orig_variable, $orig_value, $orig_scale) = &get_extract_line($orig_line);
        ($new_number,$new_variable, $new_value, $new_scale) = &get_extract_line($new_line);

        if ( $orig_number < 0 || $new_number < 0 ) {
          close (ORIG_EXTRACT) ;
          close (NEW_EXTRACT) ;
          $failtype ="serious_9";
          goto SERIOUS_FAILURE ;
        }

       if ( ( $new_variable eq "NoSolverLic" ) 
              and $run_test_id ne $license_check_qa ) {
           $num_no_license ++;
           $no_lic_falures .= " $full_test_id" ;
           $out_buffer .= "    *** License failure\n" ;
           &preserve_files ;
           close (ORIG_EXTRACT) ;
           close (NEW_EXTRACT) ;
         $failtype ="serious_10";
           goto LIC_FAILURE ;
       }
       elsif ( $new_variable =~ /^(ECHO |qadiags.inc |OSDIAG|SYSSETTING)/ ) {
           $has_bad_example = 1 ;
       }
       elsif ( $new_variable =~ /^SignalHandler/ ) {
           $noerrqa = 0;
           if ( $last_sig_failure ne $full_test_id ) {
           $no_sig_failures ++;
           $list_sig_failures .= " $full_test_id" ;
       }
           $last_sig_failure = $full_test_id ;
       }
       elsif ( $new_variable =~ /^prgerr_/  ) {
           $out_buffer .= "    *** ProgErr Crash: ($new_number) $new_variable $new_value\n" ;
           &preserve_files ;
           close (ORIG_EXTRACT) ;
           close (NEW_EXTRACT) ;
        $failtype ="serious_12";
           $noerrqa = 0;
          goto SERIOUS_FAILURE ;
       }
       elsif ( $new_variable =~ /^(misknt_|suspect_)/  ) {
           $out_buffer .= "    *** Array usage error: ($new_number) $new_variable $new_value\n" ;
           &preserve_files ;
           close (ORIG_EXTRACT) ;
           close (NEW_EXTRACT) ;
        $failtype ="serious_12";
           $noerrqa = 0;
          goto SERIOUS_FAILURE ;
       }
       elsif ( $new_variable =~ /^OptiStructErrNo/ ) {
           $noerrqa = 0;

           if ( $new_value == -5.0 ) {
         $count_timeout ++ ;
         $list_timeout .= "$full_test_id ";
         $out_buffer .= " **** TIMEOUT:" ;
         if ( $count_timeout > 10 and not $no_count_timeout) {
             print STDERR "Too many timeouts - aborting QA\n";
             $abort_reason = "Too many timeouts" ;
             $aborted_run = 1;
             goto ENDFILE;
         }
         $failtype ="serious_5";
         goto SERIOUS_FAILURE;
           }
           if ( $echo_test && ($new_value == 1401) ) {
         # OptiStruct specific: 1401 means mixed old opti cards
         # which is not supported in ECHO
         goto SKIP;
           }
           if ( ($orig_variable ne $new_variable) || ($orig_value != $new_value) ) {
          foreach $errcode (@err_ids_traced) {
              if ( abs($new_value - $errcode) <= 0.7 &&
             $last_traced_qa ne $full_test_id ) {
            $err_trace{$errcode} .= " $full_test_id" ;
            $err_counts{$errcode} ++;
            $last_traced_qa = $full_test_id;
              }
          }
          if ( $new_value == 2.0 || $new_value < 0.0 ) {
              $num_crashes ++ ;
              $list_of_crashed .= " $full_test_id";
          }
            }
       }
       if ( ($orig_variable ne $new_variable)  ) {
           if ( $has_match != 0 ) {
         &check_names_match() ;
           }
       }
       
             if (($orig_number == $new_number) && ($orig_variable eq $new_variable)) {
           $tol1 = $rel_fail ;
           $tol2 = $zero_fail ; # store if failed but has local
                 my $iabs_tolerance_old=$iabs_tolerance;
                 my $abs_tolerance_old=$abs_tolerance;
                 if ($fix_tolerances == 2) {
                   $iabs_tolerance=1;
                   $abs_tolerance=0;
                 }
           $tmp = &within_tolerance($orig_value, $new_value, $new_variable);
                 if ($fix_tolerances == 2) {
                   $iabs_tolerance=$iabs_tolerance_old;
                   $abs_tolerance=$abs_tolerance_old;
                 }
           $tmptol0 = $tmp;
           &save_tol ;
                 $tmp1 = 0;
                 $tmptol=$tmptol0;
             &update_within_tol(\%within_tolerances0,$tmptol0,$tolerance_type,$tolerance_code,$authorized_diffs,$observed_diffs);

             $test_tolerances{$full_test_id}{'Diff_Tolerance'}=$diff_tolerance;
             $test_tolerances{$full_test_id}{'Zero_Tolerance'}=$zero_tolerance;
             $test_tolerances{$full_test_id}{'Rel_Int_Tolerance'}=$rel_int_tolerance;
             $test_tolerances{$full_test_id}{'Int_Tolerance'}=$abs_int_tolerance;
             foreach $ii ( @stack_global ) {
             ( $vname, $tolname, $val_tol ) = 
           ( $ii =~ /^(\S*)\s*(\S*)\s*(\S*)/ );
                 $test_tolerances{$full_test_id}{$vname}{$tolname}=$val_tol;
             if ( $orig_variable =~ /^$vname/ ) {
           &change_tol ( $tolname, $val_tol );
           $tmp1 = 2;
           $tmptol = 1;
             }
         }
         foreach $ii ( @stack_local ) {
             ( $vname, $tolname, $val_tol ) = 
           ( $ii =~ /^(\S*)\s*(\S*)\s*(\S*)/ );
             $test_tolerances{$full_test_id}{$vname}{$tolname}=$val_tol;
             if ( $orig_variable =~ /^$vname/ ) {
           &change_tol ( $tolname, $val_tol );
           $tmp1 = 2;
           $tmptol = 1;
             }
         }
    #         & update_within_tol(\%within_tolerances,'undef','undef','undef','undef','undef');
             if ( $tmp1 == 2 ) { # i.e. any match with stacks
                 my $iabs_tolerance_old=$iabs_tolerance;
                 my $abs_tolerance_old=$abs_tolerance;
                 if ($fix_tolerances == 2) {
                   $iabs_tolerance=1;
                   $abs_tolerance=0;
                 }
           $tmp2 = &within_tolerance($orig_value, $new_value, $new_variable);
                 if ($fix_tolerances == 2) {
                   $iabs_tolerance=$iabs_tolerance_old;
                   $abs_tolerance=$abs_tolerance_old;
                 }
                 $abs_tolerance=$abs_tolerance_old;
           $tmptol = $tmp2;
                 &update_within_tol(\%within_tolerances,$tmptol,$tolerance_type,$tolerance_code,$authorized_diffs,$observed_diffs);
             if ( $tmp2 ) {
           $rel_fail = $tol1 ;
           $zero_fail = $tol2 ; # restore if failed but has local
           $tmp = $tmp2;
             }
         }
           if (! $tmp ) {  
        if ( ! $num_diffs ) {
            $out_buffer .= "      $original_extract_file out of tolerance:\n" ;
            $out_buffer .= $diff_buffer;
            $ diff_buffer = "";
            if ( ($#alternate_extract_file >= 0) && ! $fix_tolerances ) {
          &another_extract ;
          goto RESET_EXTRACT ;
            }
        }
        $out_buffer .= &out_extract ( $orig_number, $orig_variable,
                 $orig_value, $new_value,$tmp);
                   $num_diffs++ ;
                } elsif ( $show_extract || ($num_diffs && $show_extract_full ) ) {
        $out_buffer .= &out_extract ( $orig_number, $orig_variable,
                 $orig_value, $new_value,$tmp);
                } elsif ( $show_extract_full ) {
        $diff_buffer .= &out_extract ( $orig_number, $orig_variable,
                 $orig_value, $new_value,$tmp);
          }
           &get_tol ;
             } else {
    #            print "        $prog_name: not ok - error in &go \n";
          if ( ! $num_diffs ) { 
        $out_buffer .= "      New_extract and $original_extract_file differ:\n" ;
        if ( ($#alternate_extract_file >= 0) && ! $fix_tolerances ) {
            &another_extract ;
            goto RESET_EXTRACT ;
        }
    ##### !!!!! dbg_stopqa_infos_extract
          if ($dbg_stopqa_infos_extract == 1) {
            printf STDOUT "\n##### !!!!! input : $tmp_file_input\n";
            printf STDOUT "\n##### !!!!! extract : $tmp_file_extract\n";
            print STDOUT "##### !!!!! org extract :\n" . $org_ext_tmp ."\n##### !!!!! org extract end.\n";
            print STDOUT "##### !!!!! new extract :\n" . $new_ext_tmp ."\n##### !!!!! new extract end.\n";
            exit;
          }
          }
          if ( length($orig_variable)>20 || length($new_variable)>20 ) {
        $tmp = "%6d     %-35s %-$precision \n      ->> %-35s %-$precision\n";
          } else {
        $tmp = "%6d %-20s %-10.4g ->> %-20s %-10.4g\n";
          }
          $out_buffer .=
        sprintf($tmp,
          $orig_number,$orig_variable,$orig_value,
          $new_variable,$new_value);
          $num_diffs++ ;
          if ( substr($new_variable,0,9) eq "ConstViol" &&
         substr($new_variable,0,9) eq "ConstViol" ) {
        if ( $nr_err == 0 ) { $nr_err = 1 ; }
          } elsif ( substr($new_variable,0,9) eq "ITERATION" &&
          substr($new_variable,0,9) eq "ITERATION" ) {
        if ( $nr_err == 0 ) { $nr_err = 1 ; }
          } else {
        $serious_failure = 1;
          }
          if ( $nr_err == 0 ) {
        if ( substr($new_variable,0,8) eq "InputErr" ) {
            $nr_err = 2 ;
            $num_read_failures ++ ;
            $list_read_err .= ",$full_test_id" ; 
        }
          }
             }
             $orig_line = <ORIG_EXTRACT>;
             $new_line  = <NEW_EXTRACT>;
          } # end of while (($orig_line) .. ($new_line)) 


          if (($orig_line ) || ($new_line )) {
             $out_buffer .= "      $prog_name: One of the extract files is longer than the other.  \n" ;
             # $out_buffer .= "      $prog_name: The remainder of the longer file :\n\n" ;
       if ( ($#alternate_extract_file >= 0) && ! $fix_tolerances ) {
           &another_extract ;
           goto RESET_EXTRACT ;
       }
             $num_diffs++ ;
       $serious_failure = 1;
       # the lines are not chompped so no \n at the end is needed
             if ($orig_line ) {
                $out_buffer .= "            extract_original: $orig_line" ;
       }
             if ($new_line ) {
                $out_buffer .= "            extract_current: $new_line" ;
       }
       $n = 0;
             while (<ORIG_EXTRACT>) {
                chomp ;
                $out_buffer .= "            extract_original: $_\n" ;
          $n ++ ;
          if ( $n >= 5 ) { last; }
             } 
             while (<NEW_EXTRACT>) {
                chomp ;
                $out_buffer .= "            extract_current: $_\n" ;
          $n ++ ;
          if ( $n >= 5 ) { last; }
       }
       if ( $n >= 5 ) { $out_buffer .= "            ....\n" ; }
          }
          close (ORIG_EXTRACT) ;
          close (NEW_EXTRACT) ;
          open (ORIG_EXTRACT, "<$original_extract_file");
          @orig_extract1=<ORIG_EXTRACT>;close(ORIG_EXTRACT);
          open (NEW_EXTRACT, "<$extract_file");
          @new_extract1=<NEW_EXTRACT>;close(NEW_EXTRACT);
    # updated only if failure exists 
    # otherwise it will be initialized later on (tracker_report)
          &update_extracts();
          &update_failure($full_test_id,'last');
       }
        if (-f "screen_xtra_infos") {
          open(FXTRA,"screen_xtra_infos");my @xtra_infos=<FXTRA>;close(FXTRA);
          my $xtra_infos=join('',@xtra_infos);
          if ($output_xtra_infos and $echo_radioss) {
            &out_file($xtra_infos);}
        }
    #
    # end of loop over entries in the extract file
    #
       if ( $noerrqa && $noerrqafile ) {
           if ( $noerrqalist ) {
               $noerrqalist .= ",$full_test_id" ;
           } else {
               $noerrqalist = "$full_test_id" ;
           }
       }

       if( $num_diffs || $no_original_extract_file || $create_ref ) {
    #     if we are force overwriting the extract files       
          if ( $force_extract_overwrite ) {
        if ( ! $noerrqa || $has_bad_example ) {
            $knt_bad_ovr .= " $full_test_id"; }
              #extract_file=qshl3_sz1_mpi.extract
              #base_extract_file=../testmpi/qshl3_sz1_mpi.extract
              #original_extract_file=../testmpi/qshl3_sz1_mpi.extract2
        if ( $extract_suffix && (-f $base_extract_file.$extract_suffix) ) {
            system ("cp -f $extract_file $base_extract_file$extract_suffix");
            system ("git add $base_extract_file$extract_suffix");
            $git_opened .= " $base_extract_file$extract_suffix" ;
        } elsif ( $extract_suffix ) {
            &out_file ( "\n*****" .
            "\n Can't overwrite original extract file when" .
            " --extract_suffix=$extract_suffix is defined.\n" .
            " Rerun this QA on reference host first !!!\n" .
            "****\n" ) ;
        } else {
            if (-f $base_extract_file) {
              system ("cp -f $extract_file $base_extract_file");
              $git_opened .= " $base_extract_file";
            }
            elsif ( $add_missing_extract == 0 ) {
              &out_file ( "Original extract file $base_extract_file does not exist : overwrite_extract skipped." );
            }
        }
          } 
          if ( $add_missing_extract ) {
        if ( $no_original_extract_file ) {
            if ( &grep ( $extract_file, "ECHO|qadiags.inc|OSDIAG|SYSSETTING" ) ) {
          $has_bad_example = 1 ; }
            if ( $has_bad_example ) {
          $knt_bad_example .= " $full_test_id";
          print ("**** Bad example $full_test_id - Check input data: \n Disallowed OSDIAG, SYSSETTING or ECHO, or missing \"include qadiags.inc\". \n\n" );
            } else {
          system ("cp -f $extract_file $base_extract_file");
          system ("git add $base_extract_file");
          $git_opened .= " $base_extract_file";
            }
            # check extract file for bad exit:
            $tmp = &grep ( $extract_file, "SignalHandler|prgerr_|misknt_|suspect_|OptiStructErrNo" );
            if ( $tmp ) {
          $knt_bad_add .= " $full_test_id";
            }
            
            while ( @p4_local_files ) {
          $tmp = pop ( @p4_local_files );
          system ("git add $tmp");
          $git_opened .= " $tmp";
            }
            
        } elsif($extract_suffix && (!-f $base_extract_file.$extract_suffix)){
            if ( ! $noerrqa ) { $knt_bad_add .= " $full_test_id"; }
            system ("cp -f $extract_file $base_extract_file$extract_suffix");
            system ("git add $base_extract_file$extract_suffix");
            $git_opened .= " $base_extract_file$extract_suffix";
        }
          }
       }

        if ( $num_diffs || $no_original_extract_file ) {
    #
    #     missing extract file: move the extract file if one exists
    #

          if ($no_original_extract_file) {
        if ( ! $add_missing_extract ) {
            $out_buffer .= "      No original extract file.\n"; }
        $serious_failure = 1;
          }
          &trim_outbuffer;
          $out_buffer .= "      =======>>> $full_test_id: Differences found - QA test failed.\n" ;
          goto FAILURE ;

        }elsif($#h3dfiles>=0 && $#h3d_extract_file >= 0 && $h3dtoxmlexec ){
    #
    #     Testing h3d extract file if needed
    #        
          if(! -f $h3dtoxmlexec){
            print "      $h3dtoxmlexec does not exist!\n";
            goto FAILURE;
          }
            
          open ( NEW_H3DEXTRACT, "> $local_h3d_extract" ) ;
          $h3dlinenumber=0;
          foreach $ih3dfile (@h3dfiles) {
            if(! -f $ih3dfile){
              print "      $ih3dfile is not created\n";
              goto FAILURE;
            }

            system("$h3dtoxmlexec $ih3dfile $local_h3d_xml >> $qa_screen 2>&1");
            #system("$h3dtoxmlexec $ih3dfile $local_h3d_xml");

            if(! -f $local_h3d_xml ){
                $out_buffer .= "      =======>>> $full_test_id: $local_h3d_xml not found - QA test failed.\n" ;
                goto FAILURE ;
            }
            open (NEW_XML, "< $local_h3d_xml") || die "$! $local_h3d_xml" ;
            while ($h3dline=<NEW_XML>) {
              #print "$h3dline";
              chomp ($h3dline) ;
              if($h3dline =~ /^\s*<DataSetDataInfo ID=\"(\d+)\" DataSize=\"(\d+)\" Data=\"(.*)\" \/>\s*$/){
                #<DataSetDataInfo ID="1" DataSize="3" Data="0.000000E+00,0.000000E+00,0.000000E+00" />
                $datasetid=$1;
                @datasetdata=split(/,/,$3);
                $iline=0;
                foreach $idata (@datasetdata) {
                  $iline++;
                  $h3dlinenumber++;
                  #print "$h3dlinenumber $datasetid $idata\n";
                  print NEW_H3DEXTRACT "$h3dlinenumber DataSet${datasetid}_${iline} $idata\n";
                }
              }
            }
            close(NEW_XML);
          } 
          close ( NEW_H3DEXTRACT );

          #goto compare again
          $base_extract_file=$base_h3d_extract_file;
          $original_extract_file=pop(@h3d_extract_file);
          $extract_file = $local_h3d_extract;
          if (! $extract_file) {
              $out_buffer .= "      **No h3d extract file found !!\n";
              $no_original_extract_file = 1 ;
          } else {
              $no_original_extract_file = 0 ;
          }

          if (! -f $original_extract_file){
        $out_buffer .= "      **Specified extract file $original_extract_file does not exist!!\n\n" ;
        $no_original_extract_file = 1 ;
          }

          @h3dfiles    = () ; 
          #$out_buffer .= "trying: \"$original_extract_file\"\n" ;
          goto RESET_EXTRACT;

        } else {
        #        
        #     QA test passed
        #    
          $num_runs_good++ ;
          if ( $run_err_list ) { $list_of_good .= " $full_test_id" ; }
          if ( $verbose ) {
              &out_file ( $out_buffer );
          }
          if($use_which_extract==1 && $del_suffix_extract==1) {
             system ("git rm $base_extract_file$extract_suffix");
             $git_deleted .= " $base_extract_file$extract_suffix";
          }
          my $failure_key="$full_test_id";
    #     update test status if requested
          if ($noretrack) {
            if (exists $failures{$failure_key}) {
              if ($failures{$failure_key}{'Status_flag'} <= 0) {
                $failures{$failure_key}{'Status_flag'}=$time;
                $failures{$failure_key}{'Status_flag_date'}=strftime("%d %B %Y  %H:%M", localtime($failures{$failure_key}{'Status_flag'}));
                $failures{$failure_key}{'Old_issue'}=0;
                $failures{$failure_key}{'Extract_fixed'}=join('',@{$tests_infos{$failure_key}{'Extract'}});}
                $failures{$failure_key}{'Changelist_fixed'}=$changelists[$changelist_current];
            }
          }
        
    }    
    # XXXXXX Check ERRORS in screen_save (in addition to diff in ref.extract) + Check bounds (ignore diff in ref.extract)
    # End else ignore_extract_comparison
}



#   
#   fileclean 2: save/clean files based on or_QA.constants if --save_out_files
#   
  &preserve_files ;

#
# clean remove root based files
# fileclean 3: Delete files to be deleted defined in the or_QA.files_*. after each qa
#
    &clean_up ;
#   this will delete the files specified by rename    
#    unlink <$root*> ;
    if ( $timing_check ) {
  $n = lc(substr($mark_label,0,1));
  &check_speed ( $n, $ctim, $full_test_id, $fem_file );
    }
    &out_fixfile (1);

    if($nightlyqa !=0){
       print DINFO "\$rst$run_test_id\{rst\}=pass;\n";
     print DINFO "\$rst$run_test_id\{rstdetail\}=pass;\n";

  $runcputime = fmt_time_db($ctim);
       print DINFO "\$rst$run_test_id\{cputime\}=q(${runcputime});\n";
  
  $runwalltime = fmt_time_db($wtim);
       print DINFO "\$rst$run_test_id\{walltime\}=q(${runwalltime});\n";

       print DINFO "\$rstall{q($full_test_id)}=\\%rst$run_test_id;\n";
   }

    if($check_newfile){
      &check_new_files(".each-qa-start",$full_test_id);
    }

    if (exists $tests_infos{$full_test_id}{'Failure_type'}) { $tests_infos{$full_test_id}{'Failure_type_old'} = $tests_infos{$full_test_id}{'Failure_type'}}
    $tests_infos{$full_test_id}{'Failure_type'} = $failtype;
    return;
SERIOUS_FAILURE:
    $serious_failure = 1;

    # XXXXXX Check ERRORS in screen_save (in addition to diff in ref.extract) + Check bounds (ignore diff in ref.extract)
    # In case of serious failure we copy the screen_saver_# that contains the error in a dedicated directory in the way
    # to attach it at email sending stage
    if ($found_error > -1) {

        my $screen_save_2_backup = 'screen_save_';
        my @split_array = split(//,$found_error);
        if (scalar(@split_array) == 1) {
            $screen_save_2_backup .= '0'.$found_error;
        }
        else {
            $screen_save_2_backup .= $found_error;
        }

        if (! defined($test_already_run_check_error{$full_test_id}) and -f $screen_save_2_backup) {
          system("cp -p $screen_save_2_backup  $check_error_path_4_tracking/".$full_test_id."_$screen_save_2_backup");
          $test_already_run_check_error{$full_test_id} = 1;
          push(@all_check_error_found,$full_test_id);
        }

        # Reset variable when starting a run in 1 pass
        $found_error = -1 if ($selfref_pass == 0);
    }
    # END XXXXXX
   
FAILURE:
    # XXXXXX using attached ref files in tracking email (same as for QAPRINT)
    # XXXXXX (QAPRINT QA email sending) : as the HTML email is not very usable as is (many value, html errors)
    # we want to keep the ref.extract files (both reference and run) to send them by email
    # After the first test run we copy the RD-qa.extract file
    if ( ( ( defined $ENV{'DO_QA'} and $ENV{'DO_QA'} eq 'ON') or defined $extract_from_starter ) and ! defined($test_already_run2{$full_test_id}) ) {
      # print "TRACE Copying run extracted file for test $full_test_id\n";
      if (-f $extract_file) {
        system("cp -p $extract_file  $copy_extract_path_4_tracking/".$full_test_id."_run.extract");
      }
      $test_already_run2{$full_test_id} = 1;
    }

    if ( $rel_fail > 0.1 ) {
  $serious_failure = 1;
    }
    &trim_outbuffer;
#
# move the screen output file and extract file to the storage dirs
#

    &preserve_files ;
    if ( $echo_test ) {
  system ("mv", "run.echo", $out_files_dir . "/${preserve_suffix}_" . $root . "_echo_") ;
    }
    if ( $rel_fail || $zero_fail ) {
  $out_buffer .= "    $full_test_id: " ;
  if ( $rel_fail ) {
      $out_buffer .= sprintf ( "  Rel_fail %g (>%g)", $rel_fail, $diff_tolerance )  ;
  }
  if ( $zero_fail ) {
      $out_buffer .= sprintf ("  Zero_fail %g (>%g)", $zero_fail, $zero_tolerance ) ;
  }
  $out_buffer .= "\n" ;
    }
    $num_runs_failed++ ;
    $listoffailed .= " $full_test_id" ;
    if ( $failure_file_list ) {
  $failure_file_list .= ",$full_test_id" ;
    } else {
  $failure_file_list = "$full_test_id" ;
    }
    if ( $nr_err != 2 ) {
  if ( $serious_failure ) {
      $list_error .= ",$full_test_id" ;
        if("$failtype" eq "pass"){$failtype ="serious_12";}
  } else {
      $list_tol .= ",$full_test_id" ;
        if("$failtype" eq "pass"){$failtype ="serious_13";}
  }
    } else {
  $failtype ="serious_14";
    }
    if ( $serious_failure ) {

  &diskfree ( "." );
  $tmp = "disk free: " . $p4 ;
  &diskfree ( "/tmp" );
  $tmp .= " /tmp: " . $p4;
  $out_buffer .= "    Exit $exit_value, with signal $signal_num, $tmp\n" ;

  &out_file ( $out_buffer );
  $num_serious_failed ++ ;
  &out_file ("-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*" .
       "-*-*-*-*-*-*-*-*-*-*-*-*-*-*-" .
       "($num_runs_good:$num_runs_failed:$num_serious_failed)\n" );
    }
  LIC_FAILURE:
    if ( ! $serious_failure ) {
  &out_file ( $out_buffer );
  &out_file ("----------------------------------------" .
       "-----------------------------" .
       "($num_runs_good:$num_runs_failed:$num_serious_failed)\n" );
    }
    if ($output_failures_stdout and $echo_radioss) { 
      my $nb_head=(split(',',$output_failures_stdout))[0]+0;
      my $nb_tail=(split(',',$output_failures_stdout))[1]+0;
      my @screen_save_files=glob("screen_save_[0-9][0-9]");
      push @screen_save_files,glob("screen_save_errors");
      for my $screen_file (@screen_save_files) {
        if (-f $screen_file) {
          print " ==> $screen_file\n";
          open(FSTDOUT,$screen_file);my @tab_screen_file=<FSTDOUT>;close(FSTDOUT);
          my @out_tab=();
          for (my $i=0;$i<=$#tab_screen_file;$i++) {
            if ($i<$nb_head or $#tab_screen_file-$nb_tail<$i) {
              push @out_tab,$tab_screen_file[$i];
            }
            if ($i==$nb_head and $i<=$#tab_screen_file-$nb_tail) {
              push @out_tab,"...\n";
            }
          }
          my $stdout=join('',@out_tab);
          &out_file($stdout);
        }
      }
      print " ==> end of screen_save_files\n";
    }
    if ($mail_report_flag > 0) {
      my @failures_stdout_errors;
      if (-f "screen_save_errors") {
        open(FSTDOUT,"screen_save_errors");@failures_stdout_errors=<FSTDOUT>;close(FSTDOUT);
      }
      my $stdout_errors=join('</BR>',@failures_stdout_errors);
      if (exists $tests_infos{$full_test_id}{'Stdout_errors'} ) {
        $tests_infos{$full_test_id}{'Stdout_errors_old'} = 
                                $tests_infos{$full_test_id}{'Stdout_errors'};}
      $tests_infos{$full_test_id}{'Stdout_errors'} = $stdout_errors;
    }
    &update_failure($full_test_id,'last');
    &clean_up ;
    &out_fixfile (0) ;

#
# save the failure information to detail.info
#
    if (exists $tests_infos{$full_test_id}{'Failure_type'}) { 
      $tests_infos{$full_test_id}{'Failure_type_old'} = $tests_infos{$full_test_id}{'Failure_type'}}
    $tests_infos{$full_test_id}{'Failure_type'} = $failtype;

    if ( $debug ) { print "failtype = $failtype\n" };
  if($nightlyqa !=0){
      $printtime = 0;
      if("$failtype" eq "serious_1"){
    print DINFO "\$rst$run_test_id\{rstdetail\}=q(fail to execute copy command in the qa file.);\n";
    print DINFO "\$rst$run_test_id\{rst\}=serious;\n";
    $printtime = 1;
      }elsif("$failtype" eq "serious_2"){
    print DINFO "\$rst$run_test_id\{rstdetail\}=q($fem_file file name is not defined!  Aborting the test!);\n";
    print DINFO "\$rst$run_test_id\{rst\}=serious;\n";
    $printtime = 1;
      }elsif("$failtype" eq "serious_3"){
    print DINFO "\$rst$run_test_id\{rstdetail\}=q(fail to copy $fem_file to $Run_file.);\n";
    print DINFO "\$rst$run_test_id\{rst\}=serious;\n";
    $printtime = 1;
      }elsif("$failtype" eq "serious_4"){
    print DINFO "\$rst$run_test_id\{rstdetail\}=q($out_buffer);\n";
    print DINFO "\$rst$run_test_id\{rst\}=serious;\n";
    $printtime = 1;
      }elsif("$failtype" eq "serious_5"){
    print DINFO "\$rst$run_test_id\{rstdetail\}=q($out_buffer);\n";
    print DINFO "\$rst$run_test_id\{rst\}=timeout;\n";
    $printtime = 2;
      }elsif("$failtype" eq "serious_6" 
       || "$failtype" eq "serious_7" 
       || "$failtype" eq "serious_8" 
       || "$failtype" eq "serious_9"
       || "$failtype" eq "serious_12"){
    print DINFO "\$rst$run_test_id\{rstdetail\}=q($out_buffer);\n";
    print DINFO "\$rst$run_test_id\{rst\}=serious;\n";
      }elsif("$failtype" eq "serious_10" 
       || "$failtype" eq "serious_11" ){
    print DINFO "\$rst$run_test_id\{rstdetail\}=q($out_buffer);\n";
    print DINFO "\$rst$run_test_id\{rst\}=license;\n";
      }elsif("$failtype" eq "serious_13"){
    print DINFO "\$rst$run_test_id\{rstdetail\}=q($out_buffer);\n";
    print DINFO "\$rst$run_test_id\{rst\}=tolerance;\n";
      }elsif("$failtype" eq "serious_14"){
    print DINFO "\$rst$run_test_id\{rstdetail\}=q($out_buffer);\n";
    print DINFO "\$rst$run_test_id\{rst\}=reader;\n";
      }else{
    print DINFO "\$rst$run_test_id\{rstdetail\}=q($out_buffer);\n";
    print DINFO "\$rst$run_test_id\{rst\}=serious;\n";
      }

      if($printtime == 1){
    print DINFO "\$rst$run_test_id\{cputime\}=q(00:00:00);\n";
    print DINFO "\$rst$run_test_id\{walltime\}=q(00:00:00);\n";
      }elsif($printtime == 2){
    print DINFO "\$rst$run_test_id\{cputime\}=q(00:99:99);\n";
    print DINFO "\$rst$run_test_id\{walltime\}=q(00:99:99);\n";
      }else{
    $runcputime = &fmt_time_db($ctim);
    $runwalltime = &fmt_time_db($wtim);
    print DINFO "\$rst$run_test_id\{cputime\}=q(${runcputime});\n";
    print DINFO "\$rst$run_test_id\{walltime\}=q(${runwalltime});\n";
      }

      print DINFO "\$rstall{q($full_test_id)}=\\%rst$run_test_id;\n";
  }
    if ( $changelist_minimum ) {
  # detect type of failure change during tracking
  $fail_msg = sprintf( "%6s %2d %g %g %s"   ,
           $full_test_id, $num_diffs,
           $rel_fail, $zero_fail,$failtype );
  if ( exists $track_changes{$full_test_id} ) {
      if ( $track_changes{$full_test_id} ne $fail_msg ) {
    &out_file (" <<<< Detected change in failure pattern for $full_test_id\n");
    # If some changes are detected while tracking (diff are not the same from one CL to another one), we store it in a hash detected_changes
    if (defined $detected_changes{$full_test_id} and $detected_changes{$full_test_id} ne '') {
      $detected_changes{$full_test_id} .= "\n";
    }
    $detected_changes{$full_test_id} .= "Different numerical results detected during tracking between \@ $changelists[$changelist_current+1] and \@ $changelists[$changelist_current]";
    # print $trace_fh "########################## SETTING detected_changes ##################################\n";
    if ( $changelist_current == 0 && $track_fails[1] eq "" ) {
        # here we are at the changelist pruning, we do not want
        # this failure to be excluded
        $pos = 0;
        # find the last ',' in the list
        while ( $pos >= 0 ) {
      $kk = $pos ;
      $pos = index ( $failure_file_list , ",", $pos+1 );
        }
        if ( $kk == 0 ) {
      $failure_file_list = "" ;
        } else {
      # trim last ',' to the end
      $failure_file_list =
          substr ( $failure_file_list, 0, $kk);
        }

    } else {
        $track_changes_txt .=
      "\n $full_test_id: Failures appear different"  .
      " \@ $changelists[$changelist_current+1] and" .
      " \@ $changelists[$changelist_current]"
    }
      }
  }
  if ( $changelist_current != 0 ) {
      $track_changes{$full_test_id} = $fail_msg ;
  }
    }
    
    return ;

  SKIP:
    &out_file ( " Test $full_test_id skipped ($why)\n" ) if ( $echo_marks ) ;
    $skip_this_multi_test = 1;
    $num_runs_skipped ++;
    $skip_becse_require = "";
    &clean_up ;
    &out_fixfile (0) ;
    return;
}
# END of &go()

#########################################################################
#########################################################################
### DONE with processing, close, clean, sum up.
#########################################################################
#########################################################################

foreach  $ii ( split('/',$executable) ) {
    $exname = $ii;
}
if ( $exname eq "QA.code" || $exname eq "QA.code.exe" ) {
    if ( open (LOCEXE, "< $exe_name_file") ) {
  $exname = <LOCEXE>;
  chomp $exname ;
  close LOCEXE;
  substr($exname,0,3) = "@@@";
    }
} 

($usercpu, $systemcpu, $cusercpu, $csystemcpu) = times;
$ctim_fmt = &format_time ($csystemcpu + $cusercpu );
$wtim_fmt =  &format_time ( time - $timestart );

if ($nightlyqa !=0 && !$running_double_check ) {
    $runcputime = &fmt_time_db($csystemcpu + $cusercpu);
    print DINFO "\$run\{runcputime\}=q(${runcputime});\n";

    $runwalltime = &fmt_time_db(time - $timestart );
    print DINFO "\$run\{runwalltime\}=q(${runwalltime});\n";
}

$date = localtime ;
&out_file ( $eq_line ) ;
$tmp = "completed";
if ( $aborted_run ) { $tmp = "aborted"; $ever_aborted = 1; }
if ( $running_double_check ) { $tmp = "double checked"; }
if ( $repeat_qa > 0 ) { $tmp = "repeat_qa=$repeat_qa"; }
if ( length ( "QA $tmp : $exname $hostname  $run_options_line" ) > 78 ) {
    if ( $repeat_qa == 0 ) {
  $run_options_line = "\n $run_options_line" ;
    }
}
if ( ! $running_tracker ) {
&out_file ("QA $tmp : $exname $hostname  $run_options_line");
&out_file ( " finished at : $date (CPU: $ctim_fmt, wall $wtim_fmt)\n\n" ) ;
&out_file ( "     # Runs Attempted  :  $num_runs_attempted\n") ;
&out_file ( "     # Runs Successful :  $num_runs_good\n") ;
if ( $num_bootstrap_tests ) {
    &out_file ( "     # Bootstrap tests :  $num_bootstrap_tests\n");
}
}
if ( $num_serious_failed ) {
    &out_file ( "     # Runs Failed     :  $num_runs_failed  " .
                "      (serious failures: $num_serious_failed)\n" ) ;
} else {
    &out_file ( "     # Runs Failed     :  $num_runs_failed\n") ;
}
if ( ! $running_tracker ) {
if ( ! $required_example && $required_example_subfile ) {
    &out_file ( "     Single file No. $required_example_subfile executed\n" );
}
if ( $run_list ) {
    &out_file ( "     Example list $run_list\n" ) ;
}
if ( $run_err_list && $num_runs_good ) {
    &out_file ( "     Examples not failing ($num_runs_good): $list_of_good\n" ) ;
}
if ( $required_example ) {
    &out_file ( "     Example to run $required_example\n" ) ;
} else {
    &out_file ( "     # Runs Skipped    :  $num_runs_skipped\n") ;
  if ( $num_runs_failed ) {
      &out_file ( "     List of failures  : $listoffailed\n") ;
  }
}
$tmp = 0;
if ( $list_error ne ""  ) { $tmp ++ ; }
if ( $list_read_err ne "" ) { $tmp ++ ; }
if ( $list_tol ne ""  ) { $tmp ++ ; }
if ( $tmp > 1 ) {
    if ( $list_read_err ne "" ) {
  substr($list_read_err,0,1) = " ";
  &out_file ( "     - Reader failures    ($num_read_failures): $list_read_err\n" );
    }
    if ( $list_error ne ""  ) {
  substr($list_error,0,1) = " ";
  $tmp = $num_serious_failed - $num_read_failures ;
  &out_file ( "     - Serious failures   ($tmp): $list_error\n" );
    }
    if ( $list_tol ne ""  ) {
  substr($list_tol,0,1) = " ";
  $tmp = $num_runs_failed - $num_serious_failed;
  &out_file ( "     - Tolerance failures ($tmp): $list_tol\n" );
    }
}
if ( $num_crashes ) {
    &out_file ( "     - Crashes         :  ($num_crashes): $list_of_crashed\n") ;
}
if ( $count_timeout ) {
    &out_file ( "     - Timeouts        :  ($count_timeout): $list_timeout\n") ;
}
if ( $no_sig_failures ) {
    &out_file ( "     - Signal handler  :  ($no_sig_failures): $list_sig_failures\n") ;
}
foreach $errcode (@err_ids_traced) {
    if ( $err_counts{$errcode} ) {
  &out_file ( "     - Traced Err $errcode found $err_counts{$errcode} times :: $err_trace{$errcode}\n" );
    }
}
if ( $num_no_license ) {
    &out_file ( "     - License failures ($num_no_license): $no_lic_falures\n" );
}
if ( ! $required_example && ! $run_list && $longest_time && !$count_timeout ) {
    &out_file ( "     # Longest example: QA_$longest_test, $longest_time_fmt.\n");
}
if ( $nlonglino > 0 ) {
    &out_file ( "     # $nlonglino out files longer than 2000 lines\n     $long_out_line" ) ;
}

}
&out_file ( $eq_line ) ;


# Add 3 sec sleep to let or_qa_timeout.pl kill himself, jenkins could have issue if command not killed yet, seen since 2021.1
if (defined $ENV{'JOB_NAME'} and $ENV{'JOB_NAME'} ne '') {
  sleep 3;
}

# preserve last list if no failures or only failures
if ( $listoffailed
     && $num_runs_good > 1
     && ($num_runs_failed >= 1
   || (! $running_double_check
       && !$changelist_minimum
       && $num_runs_failed >= 1)
     )
    ) {
    open (FAILURES, "> $failure_file" );
    print FAILURES  "$failure_file_list\n"  ;
    close FAILURES ;
} else {
    if ( $double_check != 0 ) {
  &out_file ( "Reset double check: $num_runs_good $num_runs_failed $listoffailed\n" ) ;
    }
    if ( $running_double_check ) {
  $double_check = 0;
  $running_double_check = 0;
    }
}

($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst) =
    localtime(time);
$date = sprintf("%02d-%02d-%02d %2d:%02d", $year-100, $mon+1, $mday, $hour, $min );
$sec = $wday+$yday+$isdst;

&fix_exname ;

# change the number of failures if running double check

if ( $running_double_check ) {
    $num_runs_good = $old_num_runs_good + $num_runs_good ;
} elsif ( !$old_num_runs_good ) {
    $old_num_runs_good = $num_runs_good ;
}


if ( $platform eq "NT" ) {
    $ctim_fmt = $wtim_fmt ;
    if ( $running_double_check ) {
  $ctim_fmt = $old_ctim_fmt;
    }
    $old_ctim_fmt = $wtim_fmt ;
}

if ( $noerrqafile ) {
    open (NOERRQA, "> $noerrqafile" ) ;
    print NOERRQA "$noerrqalist\n" ;
    close NOERRQA;
}

#overwrite brief.info if running double check
#if ( ! $running_double_check ) {
#}
if ( $changelist_minimum && ! $running_tracker ) {
    &make_brief_info ;
#  otherwise brief.info moved to clean_exit 
}

$ctim = ( $usercpu + $systemcpu ); # just to fool the warnings

#
# remove files:
#  fileclean 4: clean up at the end of all qa
if ( $save_out_files == 0 ) {
    unlink <*.html>, <*.h3d>, <*.igs>, <*.log> ;
    system ("touch run_bah ossmooth.err") ;
    unlink <run_*>,<runA*>,<runT*>, "ossmooth.err" ;
}

##### LOOP execution for double_check and tracker ######

if ( $repeat_qa > 1 ) {
    $repeat_qa --;
    print "Repeat qa ($repeat_qa) : $required_example\n" ;
    $running_double_check = 1;
    $double_check = 0;
    $aborted_run = 0;
    $sanity_stop = 0;
    goto DOUBLE_CHECK_START ;
}


if ( $num_runs_failed ) {

    if ( $double_check ) {
  ##### LOOP execution for double check ######
  $required_example = $failure_file_list ;
  chomp($required_example);
  print "Double checking failures: $required_example\n" ;
  $verbose = 1;
  $running_double_check = 1;
  $double_check = 0;
  $aborted_run = 0;
  $sanity_stop = 0;
  goto DOUBLE_CHECK_START ;
    }
    $double_check = 0;
    
    
    ##### LOOP execution for tracker ######
    if ( $changelist_minimum ) {

  # changelist_current goes from $#changelists to 0, until no failures
  
  
# in case of $noretrack then $required_example is filtered out of tracker loop for existing failures.
    if ($noretrack) {
## build failure key list

      my @failure_keys=split(/,/,$failure_file_list);
      $required_example="";
# build failure list
##    get saved only saved failures to retrack i.e. Status_flag= 0
###    Status_flag= 0  => automatically set (track)
###    Status_flag= -1  => manually set (no retrack)
###    Status_flag= -2  => automatically set last cl (no retrack)
###    Status_flag= [>0=timestamp]  => fixed just kept for a while (short term history)

## build failure key list keep :
## failures which do not appear in %failures or where $status_flag == 0 
## (i.e. not solved the others are timestamped)
      for $key (@failure_keys) {
        my $add_failure=1;
        my $full_id=(split(/[\s\t]+/,$key))[0];
# check if failure appear in the tracker.failures_[n]
        if (grep {$_ eq $key} (keys %failures)) {
          my $status_flag=$failures{$key}{'Status_flag'};
          my $old_issue=$failures{$key}{'Old_issue'};
          my $cl=$failures{$key}{'Changelist'};
          if ($status_flag <= 0) {
            $add_failure=0;
            print "Test $full_id removed from track list (known issue Status_flag=$status_flag)\n";
          }
        }
# add it or not to the list to be tracked
        if ($notrack_timeout) {
            my @timeout_list=split(' ',$list_timeout);
            if (grep {$_ eq $key} (@timeout_list)) {
                $add_failure=0;
                print "Test $full_id removed from track list (Timeout issues are not tracked)\n";
            }
        }
#       add it or not to the list to be tracked
        if ($add_failure == 1) {
          if ($required_example) {
            $required_example.=",".$full_id;}
            else {
            $required_example.=$full_id;}
        }
      }      
    }
    else {
          $required_example = $failure_file_list;}
  chomp($required_example);
  $track_fails[$changelist_current] = $required_example ;
  
  # for large number of failures we heuristically skip all
  # the failures present at the earlieest changelist
  if ( $nofull_track && $changelist_current == $#changelists 
       && $changelist_current > $tracker_shortcut_max_cls
       && $num_runs_failed    > $tracker_shortcut_max_failures ) {
      print "NOTE: Due to the number of failures, using the oldest executable first for tracking\n";
      $i_tracker_shortcut = 1;
      $changelist_current = 0;
      &init_tracking ;
      goto DOUBLE_CHECK_START;
  }
  elsif ( $changelist_current == 0 && $track_fails[1] eq "" ) {
      # here we are after the earliest changelist pruning
      
      $track_eliminated = $required_example ;
      $changelist_current = $#changelists ;
      
      &track_diff ( $changelist_current, 0 );
      $e_list =~ s/,$// ;
      $required_example = $e_list ;
      $track_fails[$changelist_current] = $required_example ;
      
  }
  if ( $changelist_current > 0 && $required_example ) {
      
      # if number failures is too big, tracker is needlessly expensive
      # trim the list to max 10 examples only.
      #   magic is in {0,9} - number of ',' in the list
      
      # $required_example =~ "(([0-9\.]+,){0,9}[0-9\.]+)";
      # $required_example = $1;
      
      $changelist_current --;
      &init_tracking ;
      goto DOUBLE_CHECK_START;
  }
    }
}

## Reports for special runs

if ( $git_opened || $git_deleted ) {
    print("\n Changed extract files need to be submitted:\n\n");
    print(" The list is in the file \"git_files\"\n");
    open ( GITFILES, "> p4_files" );
    print  GITFILES "$git_opened\n" ;
    close  GITFILES ;
    print   "$git_opened\n" ;
    for my $elem (split(' ',$git_opened)) {
      system("git add $elem");
    }
    
    if ( $git_deleted ) {
      open ( GITFILES, "> git_files_del" );
      print  GITFILES "$git_deleted\n" ;
      close  GITFILES ;
      print  "\n following files need to be deleted:\n" ;
      print(" The list is in the file \"git_files_del\"\n");
      print  "$git_deleted\n" ;
    }
    
    print("\nFollowing git controlled files need to be submitted:\n\n");
    system("git status -uno");
    
    if ( $knt_bad_ovr ) {
  print ( "\n    ***** WARNING ***** \n       Following fixed QA examples ended up with ERROR - please verify\n  $knt_bad_ovr \n\n" );
    }
    if ( $knt_bad_add ) {
  print ( "\n    ***** WARNING ***** \n       Following new QA examples ended up with ERROR - please verify\n  $knt_bad_add \n\n" );
    }
    if ( $knt_bad_example ) {
  print ( "\n    ***** ERROR ***** \n       Following new QA examples had disallowed OSDIAG/ECHO/SYSSETTINGS card\n       or missing include \"qadiags.inc\". This MUST be fixed !!! \n  $knt_bad_example \n\n" );
    }
}

if ( $timing_check ) {
    @tmp = ( 0, 1, 2, 3, 4, 5, 6);
    print("Statistics of time groups [secs]:\n");
    print("Shortest (#below) range (#in range) range (#above) Longest\n");
    foreach $nn (@tmp) {
  if ( $timing_stats_total[$nn] ) {
      $n1 = chr ($nn+ord("a")) ;
      
      printf(" %s:  %6.2f (%3d)%8.2f (%3d)%6.2f   (%3d)%6.2f\n",
         $n1,
         $timing_stats_min[$nn],  $timing_stats_below[$nn],
         $tmax[$nn],              $timing_stats_total[$nn],
         $tmax[$nn+1],            $timing_stats_above[$nn],
         $timing_stats_max[$nn]
       );
  }
    }
    print ( "Required corrections: $corr_up up, $corr_down down\n" );
}

if ( $scratch_count ) {
    print("There were $scratch_count scratch files cleaned\n");
}
@names = keys %filelist;
if ( $#names > 1) {
    foreach $ii  ( sort(@names) ) {
  printf(" %-25s %6s\n",$ii,$filelist{$ii} ) ;
    }
    print("\n");
}
@names = keys %filelist_bad;
if ( $#names > 1) {
    foreach $ii  ( sort(@names) ) {
  printf(" %-25s %6s\n",$ii,$filelist_bad{$ii} ) ;
    }
    print("\n");
}
&cleanup_run_files;
# remove marker to compare in check_new_files
system "rm -f .test-start" ; 
&check_new_files(".qa-start");
#overwrite brief.info if running double check
#if ( ! $running_double_check ) {
    # if it fails we are near end anyway ...
    if ( $ENV{HOME} ) {
  system ("cp brief.info \"$ENV{HOME}\"");
    }
#}
&tracker_report ;

&clean_exit;
#     print join(':',@cleanup_files);

########################################################################
# ACTUAL END-OF-SCRIPT
########################################################################
### #!/usr/local/bin/perl -w


### run_with_timeout (3, "", "sleep", 5) ;
### run_with_timeout (3, "/tmp/find.out", qw!find / -type d -print!) ;

sub run_with_timeout {

   # $_[0] = timeout, in seconds
   # $_[1] = output file.  If empty, output to STDOUT.
   # the rest = program to run.  DO NOT USE SHELL METACHARACTERS!

   # return 0 - ok, 1 - timeout, 2 - can't execute

   my $timeout     = shift ;
   my $output_file = shift ;
   my @command     = @_ ;

#   print "Running `@command', timeout = $timeout seconds.\n" ;
#   print "Output = $output_file\n" if ($output_file) ;

   # Let the system automatically reap the children.
   local ($SIG{CHLD}) = "IGNORE" ;

   my $pid = open G, "-|" ;
   my $ret = 0;
   ($usercpubc, $systemcpubc, $cusercpubc, $csystemcpubc) = times;
   if (! $pid) {

      # We don't use this because it's not so easy to report.
      #alarm $timeout - 1 ;
       local($usercpubc, $systemcpubc, $cusercpubc, $csystemcpubc);
       local ($usercpuac, $systemcpuac, $cusercpuac, $csystemcpuac);
      # This is the equivalent of `exec 2>&1'
      open STDERR,">& STDOUT" or die "Can't duplicate STDERR into STDOUT.\n";
      exec @command ;
      die "exec failed: $!\n" ;
   } ;

   if ($output_file) {
      open O, "> $output_file" or die "open failed: $!" ;
   }

   # This eval business makes me nervous, but it seems to work.
   eval { 
      local $SIG{ALRM} = sub { die "alarm\n" };                    
      alarm $timeout ;
      while (<G>) {
         if ($output_file ne "") {
            print O ;
         } else {
            print ;
         }
      }
      alarm 0 ;
      ($usercpuac, $systemcpuac, $cusercpuac, $csystemcpuac) = times;
      $ret = $cusercpuac+ $csystemcpuac - $cusercpubc- $csystemcpubc+0.001;
   } ;

   if ($@) {

      die "Unknown error $@!\n" unless $@ eq "alarm\n" ;

      warn "@command, PID $pid execution timed out after $timeout seconds.\n" ;
      $ret = 0;
      print O "\n" if ($output_file) ;
      print O "# @command, execution timed out after $timeout seconds.\n" 
         if ($output_file) ;
      print O "# ... attempting to kill with a SIGHUP ...\n" 
         if ($output_file) ;

      kill HUP, $pid ;
      sleep 1 ;
      if (kill 0, $pid) {

         print "It's being stubborn.  kill -INT ...\n" ;
         print O "# ... attempting a SIGINT ...\n" if ($output_file) ;

         kill INT, $pid ;
         sleep 1 ;
         if (kill 0, $pid) {
            print "It's being extra stubborn.  kill -KILL ...\n" ;
            print O "# ... attempting a SIGKILL ...\n" if ($output_file) ;
            kill KILL, $pid ;
            sleep 1 ;
            if (kill 0, $pid) {
               print "Still there ... I give up.\n" ;
               print O "... still there.  I give up.\n" if ($output_file) ;
            }
         }
      }
   }

   close O if ($output_file) ;
   close G ;

   return $ret;
}
#======================================================================
sub trim_outbuffer {
    if ( $show_extract || $full_diffs ) { return ; }
    if ( $out_buffer =~ "(.*\n.*\n.*\n.*\n.*\n.*\n.*\n.*\n.*\n.*\n.*\n.*\n).*\n.*\n" ) {
  $out_buffer = "$1" . "\t\t...\n" ;
    }
}
#======================================================================
sub another_extract {
    # $out_buffer .= "      \"$original_extract_file\" failed; " ;
    $original_extract_file = pop(@alternate_extract_file) ;
    # $out_buffer .= "trying: \"$original_extract_file\"\n" ;
    $use_which_extract++; 
    close ( ORIG_EXTRACT );
    close ( NEW_EXTRACT );
}   
#======================================================================
sub diskfree {
# wrapper to system df to find free disk space on ${1} disk
    $dirname = $_[0] ;
    if ($platform ne "NT") {   
  ($trash, $lin, $lin1) = split(/\n/, `df -k $dirname 2>/dev/null`) ;
  $_ = $lin ;
  ($trash, $p1, $trash, $p4, $p5) = split( ) ;
  # deal with split line due to loooooong mount path
        if ( ! $p1 ) {
            $_ = $lin1;
            ( $p1, $trash, $p4, $p5) = split( ) ;
        }       
  
  if ( $p1 =~ /\D/  &&  substr($p1,0,1) ne "-" ) {
      $p4 = $p5;
  }
  if ( $p4 < 100000 ) {
      $p4 = sprintf( "%d MB", $p4/1000 );
  } else {
      $p4 = sprintf( "%6.2f GB", $p4*0.000001 );
  }
    } else {   # NT has df.exe as FORTRAN 
  $p4 = "??" ;   
    }
}
#======================================================================
sub grep  {  
    open ( GRID, "< $_[0]" );
    $s = $_[1];
    while (<GRID>) {
  if ( grep {/$s/} $_ ) {  # compile only once
      close GRID;
      return 1;
  }     
    }
    close GRID ;
    return 0;
}
#======================================================================
sub fix_exname {
    # shorten $exname by replacing `uname` with two letters, skip all '_'
    $exshort = $exname;
    $exshort =~ s/_42/_/;
    $exshort =~ s/_Win64_/W64/;
    foreach $i ("_Linux_","_IRIX64_","_AIX_","_CYGWIN_","_Win32_","_HP-UX_", "_SunOS_", "_Darwin_","_OSF1_","_blas" ) {
  $first_let = substr($i,1,2);
  $exshort =~ s/$i/$first_let/;
    }
    $exshort =~ s/_IRIX_/I5/;
}
#======================================================================
# do_file_commands executed stored 'file' commands
# the purpose is to delay test till after execution of 'go'
#return 0 if ok, 1 if any failure detected
sub do_file_commands {
    $ret = 0 ;
    print " file_commands: ", join("::",@file_check), "\n" if ($debug);
#    print `ls c* r*` ;
    foreach $fff (@file_check) {
  if (( $fname, $command, $Etc ) = ($fff =~ /^(\S+)\s+(\S+)\s*(.*)/) ) {
      &delete ($fname);
      if ( $command eq "exists" ) {
    # exists
    if (! -f $fname) {
        $ret = 1;
        $out_buffer .= "  *** Required file \"$fname\" is missing.\n" ;
    } else {
        if ( $verbose ) {
      $out_buffer .= "      \"$fname\" was created. Ok.\n" ;
        }
    }
      } elsif ( $command eq "remove" ) {
    # remove
    # dummy to avoid error message
      } elsif ( $command eq "absent" ) {
    # absent
    if ( -f $fname) {
        $ret = 1;
        $out_buffer .="  *** File \"$fname\" should not be created.\n";
    } else {
        if ( $verbose ) {
      $out_buffer .= "      \"$fname\" was not created. Ok.\n" ;
        }
    }
      } elsif ( $command eq "string" ) {
    # string 
    if ( ! -f $fname) {
        $ret = 1;
        $out_buffer .= "  *** Required file \"$fname\" is missing.\n" ;
    } else { 
        if ( &grep ( $fname, $Etc ) ) {
      if ( $verbose ) {
          $out_buffer .= "      \"$fname\" exists and contains";
          $out_buffer .= " required string <$Etc>. Ok.\n" ;
      }
        } else {
      $out_buffer .= "  *** \"$fname\" exists but misses" ;
      $out_buffer .= " required string <$Etc>\n." ;
      $ret = 1;
        }
    }
      } elsif ( $command eq "no_string" ) {
    # no_string
    if ( ! -f $fname) {
        if ( $verbose ) {
      $out_buffer .= "      \"$fname\" was not created. Ok.\n" ;
        }
    } else { 
        if ( &grep ( $fname, $Etc ) ) {
      $out_buffer .= "  *** \"$fname\" exists but contains" ;
      $out_buffer .= " disallowed string <$Etc>.\n" ;
      $ret = 1;
        } else {
      if ( $verbose ) {
          $out_buffer .= "      \"$fname\" exists and does not";
          $out_buffer .= " contain string <$Etc>. Ok.\n" ;
      }
        }
    }
      } elsif ( $command eq "copy" || $command eq "save" || $command eq "rename" ) {
    if ( ! -f $fname) {
        $out_buffer .= " ERROR in $command:   \"$fname\" was not created. \n" ;
        $ret = 1;
    } else {
        if ( $Etc eq "" ) {
      if ( $save_folder ) {
          $path = &mksavepath ;
      } else {
          $path = $saved_files_dir ;
      }
      $newname = $path . "/" . $fname ;
        } else {
      $newname = $Etc;
        }
        if ( $command eq "save" ) {
      # add decoration
      $tmp = $executable ;
      # remove the path from exec file name
      $dirsep = "/";
      $dummy = index($tmp,$dirsep);
      while ( $dummy > -1 ) {
          $tmp = substr ( $tmp, $dummy + 1 ) ;
          $dummy = index($tmp,$dirsep);
      }
      # on NT path may have "\\" and also remove ".exe"
      if ( $platform eq "NT" ) {
          $dirsep = "\\";
          $dummy = index($tmp,,$dirsep);
          while ( $dummy > 1 ) {
        $tmp = substr ( $tmp, $dummy + 1 ) ;
        $dummy = index($tmp,$dirsep);
          }
          $tmp =~ s/.exe$// ;
          $tmp =~ s/.EXE$// ;
      }
      # find the extension
        #  $root =~ s/^.*\/// ;
      $tpos = rindex( $newname, "/" );
      if ( $tpos > 0 ) {
          $expos = index ( $newname, ".", $tpos );
      } else {
          $expos = index ( $newname, "." );
      }
      if ( $expos > 0 ) {
          $tmp .= substr ( $Etc, $expos );
          $Etc = substr ( $Etc, 0, $expos );
      }
      # strip leading "_" from decoration, just in case
      $dummy = index($tmp,"_");
      if ( $dummy > 1 ) {
          $tmp = substr ( $tmp, $dummy + 1 ) ;
      }
      # newname with decoration
      $newname = $Etc . "_" . $hostname . "_" . $tmp ;
        }
        if ( $command eq "rename" ) {
      &copy ( $fname, $newname, 2 ); # 2 for move
        } else {
      &copy ( $fname, $newname, 1 );
        }
    }
      } elsif ( $command >= 0 ) {
    # size
    $NN = (-s $fname);
    if ( ($N1,$N2) = ($Etc =~ /^([0-9]+)\s+([0-9]+)/ )) {
        # sizeUnix sizeNT sizeTolerance
        if ( $platform ne "NT" ) { $N1 = $command ; }

        $N2 += $N1 ;
        if ( ! $NN ) {
      $ret = 1;
           $out_buffer.="  *** Required file \"$fname\" is missing.\n";
        } elsif ( $NN >= $N1 && $NN <= $N2 ) {
      if ( $verbose ) {
          $out_buffer .= "      \"$fname\" exists and is of ";
          $out_buffer .= "required size.\n" ;
          $out_buffer .= "      $NN in <$N1 .. $N2>. Ok.\n" ;
      }
        } else {
      $out_buffer .= "  *** \"$fname\" exists but it is" ;
      $out_buffer .= " wrong size.\n" ;
      $out_buffer .= "      $NN not in <$N1 .. $N2>.\n" ;
      $ret = 1;
        }       
    } else {
        # size (no less than)
        if ( ! $NN ) {
      $ret = 1;
           $out_buffer.="  *** Required file \"$fname\" is missing.\n";
        } elsif ( $NN >= $command ) {
      if ( $verbose ) {
          $out_buffer .= "      \"$fname\" exists and is at ";
          $out_buffer .= "least required size. Ok.\n" ;
      }
        } else {
      $out_buffer .= "  *** \"$fname\" exists but it is" ;
      $out_buffer .= " smaller than required $command.\n" ;
      $out_buffer .= "      $NN < $command.\n" ;
      $ret = 1;
        }
    }
      } else {
    $out_buffer .= "  *** Incorrect file command syntax\n";
    $out_buffer .= "      {$fff} {$command}\n" ;
    $ret = 1;
      }
  } else {
      # no argument == exists
      if (! -f $fff) {
    $ret = 1;
    $out_buffer .= "  *** Required file \"$fff\" is missing.\n" ;
      } else {
    if ( $verbose ) {
        $out_buffer .= "      \"$fff\" was created. Ok.\n" ;
    }
      }
  }
  
    }
    @file_check = () ;
    if ( $ret ) {
  $out_buffer .= "  ****** Failed FILE tests ******\n" ;
    }
    return $ret ;
}
#======================================================================
sub search_4_nan {
    
    if ( $search_for_nan == 0 ) { return 0; }
    
    if ( open  OUTFILE, "< run.out" ) {

  $lino = 0;
  while ( <OUTFILE> ) {
      $lino ++;
      if ( /\bnan\b/i ) {
    $out_buffer .= "      NaN found at line $lino :: $_" ;
    close OUTFILE;
    return 1;
      }
  }
  close OUTFILE;

        if ( $lino > 2000 ) {
            print "$full_test_id: Out file has $lino lines.\n" ;
            if ( $lino > $longest_out ) {
                $longest_out = $lino;
                $long_out_line = "$full_test_id: Longest out file: $lino lines.\n"
            }
            $nlonglino ++;
        }
    }
    return 0;
}
#======================================================================
# do_copy_commands executed stored 'copy' commands
# the purpose is to delay copy till we know that the file is really needed
# i.e. that example will execute.
sub do_copy_commands {

    local ($label);

    foreach $temp_data_file (@to_copy ) {

  $new_name = "";
  if ( ( $t1, $t2) = ($temp_data_file =~ /^(\S.*\S)\s*>\s*(\S.*\S)\s*$/) ) {
      $temp_data_file = $t1 ;
      $t2 =~ s/\s*$//;
      $new_name = $t2 ;
  }
  # trim trailing blanks:
  $temp_data_file =~ s/\s*$// ;

  if (! -f $temp_data_file && -f "$temp_data_file".".gz" ) {
      $temp_data_file = "$temp_data_file".".gz";
  }
  
  if (! -e $temp_data_file) {
      $out_buffer .= "* $prog_name: &copy: source $temp_data_file" ;
      $out_buffer .= " doesn't exist! \nSkipping test...\n" ;
      $force_fail = 1;
      return;
  } elsif ( $add_missing_extract ) {
      push(@p4_local_files, $temp_data_file);
  }

  $data_root = $temp_data_file;
  $data_root =~ s/^.*\/// ;  # strip path

  # check and see if a zipped file was copied
  # if so, unzip the file before continuing

  if ( (! defined $ENV{'DISABLE_GZ_UNCOMPRESS_INCLUDES'} or $ENV{'DISABLE_GZ_UNCOMPRESS_INCLUDES'} ne 'ON') and   $look_for_gz eq substr($temp_data_file,-3) ) {
      if ( $new_name ) {
    $out_buffer .= "       ungzipping data file = $temp_data_file AS: $new_name\n" ;
      }
      else {
    $out_buffer .= "       ungzipping data file = $temp_data_file\n" ;
      }
      $data_root = substr $data_root,0,-3 ; # strip '.gz'
      if ( $new_name ) { $data_root = $new_name ; }
      system ("gzip -d < $temp_data_file > $data_root") ;
      if ($? >> 8) {
    $out_buffer .= "* ungzip $source failed for some reason\n " ;
    $out_buffer .= "Skipping test: \n    $!\n" ;
    $force_fail = 1;
    return; 
      }
      &delete_copy ($data_root) ;
  } else {
      
      # Copy this file to the current directory file.
      if ( -d $temp_data_file ) {
    $label = "       copying directory";
      } else {
    $label = "       copying data file";
      }
      if ( $new_name ) {
    $out_buffer .= "$label   : $temp_data_file AS: $new_name\n"  ; 
    &copy($temp_data_file, $new_name) ;
    &delete_copy ($new_name) ;
      }
      else {
    $out_buffer .= "$label   : $temp_data_file\n"  ; 
    &copy($temp_data_file) ;
    &delete_copy ($temp_data_file) ;
      }
  }
    }
    @to_copy = () ;
}  
#======================================================================
# &copy copies a file to the local directory, and adds it to @delete_list,
# which is a list of files to remove when the script ends.
# The second option is optional.  If not given, it will be the same
# name as the original file.
# Returns the $dest value.
# optional third argument, if present, prevents the destination
# from being cleaned afterwards ... but if it is 2, then changes copy into move
#
# copy allows now folder names. On Windows it copies, on true OS softlinks

sub copy {

   local ($source, $destination, $keep, $doit) ;

   if (! $_[0]) {
      die "Usage: &copy \$file [\$destination]\n" ;
   }

   $source = $_[0] ;

   if ($_[1]) {
      $destination = $_[1] ;
   } else {
      $destination = $source ;
      $destination =~ s/^.*\/// ; 
   }
   if ($_[2]) {
       $keep = $_[2];
   } else {
       $keep = 0;
   }
   $doit = "cp" ;
   if ( $keep == 2 ) {
       $doit = "mv" ;
   }

   if ( -d $source ) {
       if ( $platform ne "NT" ) {
     $doit = "ln -s";
#    &out_file("Linking folder $source to $destination\n");
       } else {
     $doit = "cp -r";
#    &out_file("Copying folder $source to $destination\n");
       }
   } elsif (! -f $source) {
       &out_file("$prog_name: &$doit: source $source doesn't exist! Skipping test...\n");
       $force_fail = 1;
       return;
   }

   if (-e $destination && $verbose ) {
       sleep 1 ;
       if (-e $destination and $clean_local_file) {
     warn "$prog_name: &$doit: destination $destination already exists - overwriting!\n" ;
     unlink ($destination) ;
       }
   }

   print "-> Copying $source to $destination\n" if ($debug) ;

   if ($clean_local_file) {
   if (system ("$doit $source $destination")!=0){; 
     &munlink ($destination) ;
     system ("$doit $source $destination"); 
   }
   if ($? >> 8) {
      &out_file("$doit $source to $destination failed for some reason, Skipping: \n    $!\n") ;
      system("ls -ld $source $destination");
      $force_fail = 1;
      return; 
   }
   }
   system ("ls -l $source $destination") if ($debug) ;
   # this needed for Mac (because it fails to open read only file)
   if ( $uname eq "Darwin" ) {
       system ( "chmod", "444", $destination );
   }

   if ( $keep == 0 ) {
       &delete ($destination) ;
   }

   return $destination ;
}

#======================================================================
# Adds a filename or group of filenames to the current delete list.
sub delete {
   push (@to_delete, @_) ;
}
#======================================================================
# Adds a filename or group of filenames to the current delete list.
# these files are deleted even with --save_out_files run
sub delete_copy {
   push (@to_delete_copy, @_) ;
}
#======================================================================
# try multiple unlink one file after sleep
sub munlink {
   $delfile=$_[0];  
   unlink ($delfile) ;
   if ( -f $delfile ) {
    unlink ($delfile) ;
    if ( -f $delfile ) {
     $try_del_times=0;
     while ($try_del_times<=5 && -f $delfile){
       warn "$prog_name: delay 1s to delete $delfile again\n" ;
       sleep 1;
       unlink ($delfile);
       $try_del_times++;
     }
     if(-f $delfile){
       warn "$prog_name: unable to delete $delfile after trying $try_del_times times\n" ;
     }
    }
   }
   
}

#======================================================================
# try multiple system after sleep
sub msystem {
   $delay = 0;
   while ($delay<=5 && system(@_)!=0){
     $exec_errmesg=$!;
       warn "$prog_name: system has error mesg $exec_errmesg\n" ;
       if($exec_errmesg !~ /No such file or directory/){last;}
       if ( $delay > 0 ) {
     warn "$prog_name: delay $delay s to run @_ again\n" ;
       }
       sleep $delay;
       $delay ++ ;
   }
   if($delay>5){
       warn "$prog_name: unable to run @_ after trying $delay times\n" ;
   }
}
   
#======================================================================
# try multiple system exec after sleep
sub mesystem {
   #normal exit & qa                 ==>$!=0,$?=0,  errno=0
   #input error exit & normal qa     ==>$!=2,$?=512,errno=2
   #sh: QA.capture: Permission denied==>$!=2,$?=256,errno=1
   my($maxtime,$runcmd,$runout)=@_;
   #print "maxtime,runcmd,RUNOUT=$maxtime,$runcmd,$runout\n";

   if ($system_run) {
     system("$runcmd 1>tmp_out 2>&1"); 
     open(my $fh,"tmp_out");my @tmp=<$fh>;close($fh);for (@tmp) {print $runout $_;}
     return; 
   }
   $childpid=open(FROMCHILD,"$runcmd 2>&1 |");
   my $childpid_int=$childpid+0;
   if ($childpid_int ne $childpid) {
     $out_buffer .= "Failed to open child command" . "\n" ;
     $out_buffer .= $childpid . "\n" ;
     $failtype ="serious_16";
      goto SERIOUS_FAILURE;
   } 
   if ($childpid){
       #parent
       eval{
           local $SIG{ALRM} = sub {kill 9, -$childpid;die "alarm\n"};
           alarm $maxtime ;
           while(<FROMCHILD>){
             print $runout $_; 
           }
           close(FROMCHILD);
           alarm 0;
       };
       if ($@) {
            # timed out
            print STDERR ">>> $full_test_id timed out ($maxtime sec)\n" ;
            $out_buffer .= ">>> QA run $full_test_id $mark_label "
                ."$fem_file timed out ($maxtime sec).\n" ;
            $count_timeout ++ ;
            $list_timeout .= "$full_test_id ";
            $out_buffer .= " **** TIMEOUT " ;
            $tests_infos{$full_test_id}{'Timeout'}=$maxtime;
            if ( $count_timeout > 10 and not $no_count_timeout) {
    print STDERR "Too many timeouts(me) - aborting QA\n";
    $abort_reason = "Too many timeouts(me)" ;
    &clean_exit ;
            }
            $failtype ="serious_5";
            goto SERIOUS_FAILURE;
       }
   }else{
       #child
       exit 0;
       #exec $runcmd;
   }
   # safety for break status messing up with $?
   $tmp = substr ($?,0,1) ;
   if ( $tmp ge "0" && $tmp le "9" ) {
       $exit_value  = $? >> 8;
       $signal_num  = $? & 127;
       $dumped_core = $? & 128;
   } else {
       $exit_value = "??";
       $signal_num = "??" ;
       $dumped_core = "??" ;
   }
}

#======================================================================
# fileclean 3: Delete files to be deleted defined in the or_QA.files_*. after each qa
sub clean_up {
#     print "Clean_up:: ", join("::",@to_delete), ";;",
# join("::",@to_delete_copy), "\n" if ($debug);
    foreach $file (@to_delete_copy) {
  $file =~ s/^.*\/// ;
  if (-f $file || -l $file) {
      print "-> deleting old file $file ...\n" if ($debug) ;
      unlink $file || warn "can't unlink $file: $!\n" ;
  }
  elsif (-d $file) {
      print "-> deleting folder $file ...\n" if ($debug) ;
      unlink  glob "$file/*" ;
      rmdir $file || warn "Can't remove folder $file: $!\n" ;
    }
    }
    @to_delete_copy = () ;
    if ( $save_out_files ) { @to_delete = () ; return; }
    foreach $file (@to_delete) {
  if ( ! $file =~ /^\/.*/ ) {
      $file =~ s/^.*\/// ;
  }
  if (-f $file || -l $file) {
      print "-> deleting old file $file ...\n" if ($debug) ;
      unlink $file || warn "can't unlink $file: $!\n" ;
  }
  elsif (-d $file) {
      print "-> deleting folder $file ...\n" if ($debug) ;
      unlink  glob "$file/*" ;
      rmdir $file || warn "Can't remove folder $file: $!\n" ;
  }
    }
    @to_delete = () ;
}
#======================================================================
#  output data to fix include file
sub out_fixfile {

    if ( $fix_qa_files && $in_include ) {
  if ( $_ ) {
      $n = lc(substr($mark_label,0,1));
      &check_speed ( $n, $ctim, $full_test_id, $fem_file );
      $new_mark_label = $new_speed . substr($mark_label,1);
  }
  else {
      $new_mark_label = $mark_label ;
  }
  print $fixfile "\n#_# $full_test_id\ntest $new_mark_label\n";
  print $fixfile $fix_echo ;
    }
    $fix_echo = "";
}
#======================================================================
sub get_extract_line {
#parse extract line (old or new) into 4 items, scale is optional, lineno
# is returned as negative if error
    my ( $lineno, $variable, $value, $scale );
    my ( $in_line ) = $_[0];
    $scale = 0 ;
    if ( $in_line  =~  /^\s*(\d+)\s+(\S+)\s+([\deEdD+\.\-]+)\s+([\deEdD+\.\-]+)\s*$/ ) {
  $lineno = $1;
  $variable = $2;
  $value = $3;
  $scale = $4 ;
    } elsif ( $in_line  =~  /^\s*(\d+)\s+(\S+)\s+([\deEdD+\.\-]+\s*$)/ ) {
  $lineno = $1;
  $variable = $2;
  $value = $3;
    } elsif ( $in_line  =~  /^\s*(\d+)\s+(\S+)\s+(.nfinity)\s*$/ ) {
  $lineno = $1;
  $variable = $2;
  $value = 1e30;
    } else {
  $out_buffer .= "      **Invalid extract line: $in_line\n";
  $lineno = -1;
  $variable = "_";
  $value = 0;
    }

    return ($lineno,$variable, $value, $scale);
}
#======================================================================
sub make_brief_info {

    &fix_exname ;
    
    ($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst) =
  localtime(time);
    $date = sprintf("%02d-%02d-%02d %2d:%02d",
        $year-100, $mon+1, $mday, $hour, $min );
    $sec = $wday+$yday+$isdst;
    
    open (HISTORY, ">> qaruns.summary" ) ;
    
    if ( $running_double_check  ){
  $tmp = ":" . $orig_run_mark ;
    }else{
  $tmp = ":" . $required_example . $orig_run_mark ;
    }
    if ( ! $required_example && $required_example_subfile ) {
  $tmp = ":". $orig_run_mark . ":" . $required_example_subfile;
    }

    if ( $qa_fem_files_file ne "or_QA.files_all" ) {
  if ( length($qa_fem_files_file) >= 13 ) {
      $tmp = substr($qa_fem_files_file,13,5) . $tmp;
  }
    }
    $temp = sprintf("%-19s%-10s %-8s %s %s,ok%4d,f%2d",
        substr($exshort,2,19), substr($tmp,0,10), 
        $hostname, $date, $ctim_fmt,
        $num_runs_good, $num_runs_failed);
    $ttemp = "";
    if ( $num_runs_failed ) {
  $temp .= ":$listoffailed" ;
    }
    elsif ( $required_example && ! $running_double_check ) {
  $ttemp = " ($required_example)" ;
    }
    print HISTORY "$temp $ttemp\n" ;
    close HISTORY;
    
    unlink "brief.info" ;
    open ( BRIEFINFO, ">> brief.info" ) ;
    print  BRIEFINFO "$temp\n" ;
    if ( $num_serious_failed ) {
  $temp = "$list_read_err $list_error";
  if ( length("$temp") > 50 ) {
      $temp = substr($temp,0,40) . "..." ;
  }
  print  BRIEFINFO "$num_serious_failed serious failures: ".
      "$exname,$hostname:$orig_run_mark: $temp\n" ;
    }
    if ( $num_no_license ) {
  $temp = "$no_lic_falures";
  if ( length("$temp") > 50 ) {
      $temp = substr($temp,0,40) . "..." ;
  }
  print  BRIEFINFO "$num_no_license license failures: "
      ."$exname,$hostname:$orig_run_mark: $temp\n" ;
    } 
    if ( $abort_reason ) {
  print  BRIEFINFO "$hostname $exname: $abort_reason\n" ;
    }
    close BRIEFINFO ;
}
#======================================================================
# Handle interrupts.
sub interrupt_handler {
   local ($sig) = @_ ;
   warn "caught a SIG$sig -- aborting ...\n" ;
   $abort_reason = "aborting because of a SIG$sig signal";
   sleep(1);
   &clean_exit;
}

#clean and exit 
sub clean_exit {
    if ( $tmp_exec_name ne "" ) {
  &delete ( $local_executable ) ;
    }
    system ( "rm -f core*" );
    &cleanup_run_files ;
    &clean_up ;
   
    open ( RUNID, "> $run_id_file" );
    print  RUNID "done\n" ;
    close  RUNID ;
    &closedinfo;

    if ( ! $changelist_minimum ) {
  &make_brief_info ;
    }

   if ( $postqa_run ) {
       print "Executing post_qa_run: $postqa_run $runmpiqa\n" ;
       system ("$^X $postqa_run $runmpiqa");
   }

   if ( $qacards ) {
       system "mv ${qadiaginc}.bk ${qadiaginc}";
   }

    if ( $nightlyqa && ($executable ne $local_executable) ) {
  # clean exec from local folder
  unlink ($local_executable)
    }
   #close (PARASUM) if ( $parasumopen );
   
   if ( $aborted_run != 0 || $ever_aborted != 0 ) { exit(1); }
   
   exit 0 ;
}

#======================================================================
# Returns true if they numbers are within tolerance.
sub within_tolerance {

   # Uses global variables like $diff_tolerance as well.

   local ($old,$new,$diff,$old_i,$new_i) ;

   $tolerance_type='';
   $tolerance_code=-1;
   $authorized_diffs="";
   $observed_diffs="";
   $neglected_values="";
   $old = $_[0] ;
   $new = $_[1] ;
   $variable_name = $_[2] ;
   my $orig_new=$new;
   my $reftxt='Ref';

   my $has_float = $_[0].$_[1];
   if ($has_float =~ /[eEdD.]/) { $has_float='1' }

   $diff = abs ( $old - $new );
   $observed_diffs=$diff;
   if ($old < 0) {$old = -$old;}
   if ($new < 0) {$new = -$new;}

   if ( $use_abs_values > 0 ) {
       $diff = abs ( $old - $new );
       $use_abs_values = 0;
   }

   $old_i = int $old ;
   $new_i = int $new ;

   $loc_zero = 0;
   $loc_diff = 0;
   $abs_diff = 0;
   $interval_diff = 0;

   # if scale is set, then it can be used for threshold or just for scaling
    # if ( ! $fix_tolerances and ! $no_check_emax and $extract_ref_values{'emax'} and ($variable_name eq 'IENERGY' or $variable_name eq 'KENERGYT' or $variable_name eq 'KENERGYR' or $variable_name eq 'EXTWORK') ) {
    if ( ! $fix_tolerances and ! $no_check_emax and %extract_ref_values and ($variable_name eq 'IENERGY' or $variable_name eq 'KENERGYT' or $variable_name eq 'KENERGYR' or $variable_name eq 'EXTWORK') ) {
      print "==== If scale ($extract_ref_values{'emax'}) is defined ====\n" if ($dbgout);
      $observed_diffs=$diff;
      $authorized_diffs=$scale_factor_delta_vs_emax;
      $neglected_values="";

      # If ref is small regarding the emax we check the delta regarding the emax
      print "\t --- Checking if reference < Emax*scale_factor_emax ($extract_ref_values{$variable_name} < $extract_ref_values{'emax'}*$scale_factor_emax)\n" if ($dbgout);
      # if ($scale_factor_emax and $old < $scale*$scale_factor_emax) {
      if ($scale_factor_emax and $extract_ref_values{$variable_name} < $extract_ref_values{'emax'}*$scale_factor_emax) {
        print "\t --- YES\n" if ($dbgout);
        # If delta is small regarding the emax we ignore it
        if ( $scale_factor_delta_vs_emax ) {
          # Diff smaller than $scale*$scale_factor_delta_vs_emax is accepted (RADIOSS)
          print "\t\t --- Checking if diff < Emax*scale_factor_delta_vs_emax ($diff < $extract_ref_values{'emax'}*$scale_factor_delta_vs_emax)\n" if ($dbgout);
          # if ( $diff < $scale*$scale_factor_delta_vs_emax ) {
          if ( $diff < $extract_ref_values{'emax'}*$scale_factor_delta_vs_emax ) {
            print "\t\t --- YES, ignoring the DIFF !!!\n" if ($dbgout);
            $tolerance_type='Delta/Emax<';
            $observed_diffs = $observed_diffs / $extract_ref_values{'emax'};
            if ($show_extract_full) {
            print("-----> diff is lower than Emax*scale_factor_delta_vs_emax  \n");}
            $tolerance_code=91;
            return 1;
          }
          print "\t\t --- NO\n" if ($dbgout);
        } 
        else {
          #scale is used instead of old for scaling
          $scale = $extract_ref_values{'emax'};
          if ( $old < $scale ) { 
            $old = $scale; 
            $reftxt='Scale';
          }
        }       
      }
      print "\t --- NO\n" if ($dbgout);
    }

   # check for integers
   # NOTE: we can only tell if a number is an integer if its value is
   # less than biggest_int.  This means that integers larger than this
   # value will be treated as floats and thus do not have to be exact!
   if ($iabs_tolerance) {
     $tolerance_type='Delta<=';
     $authorized_diffs=$abs_tolerance;
     $observed_diffs=$diff;
     if ($diff > $abs_tolerance) {
       $abs_diff = $diff;
       $tolerance_code=120;
       $neglected_values="";
       return 0;
     } else {
       $tolerance_code=121;
       $neglected_values="";
       return 1;
      }
   }

   if ($interval_tolerance) {
     $tolerance_type='Interval=';
     my @limits=split(';',$interval_tolerance);
     my $limit_inf=$limits[0];
     my $limit_sup=$limits[1];
     $authorized_diffs="[$interval_tolerance]";
     $observed_diffs=$orig_new;
     if ( $orig_new < $limit_inf or $limit_sup < $orig_new ) {
       $interval_diff = 1;
       $tolerance_code=100;
       $neglected_values="";
       return 0;
     } else {
       $tolerance_code=101;
       $neglected_values="";
       return 1;
     }
   }

   if ($abs_tolerance) {
     $tolerance_type='Delta<=';
     $authorized_diffs=$abs_tolerance;
     $observed_diffs=$diff;
     if ($diff > $abs_tolerance) {
       $abs_diff = $diff;
       $tolerance_code=110;
       $neglected_values="";
       return 0;
     } else {
       $tolerance_code=111;
       $neglected_values="";
       return 1;
      }
   }

   if ($has_float ne '1') {
   if ( ($old < $biggest_int) && ($old == $old_i) 
     && ($new < $biggest_int) && ($new == $new_i) ) {
       if ($rel_int_tolerance*$new > $abs_int_tolerance) {
         $tolerance_type='Deltai/Ref<=';
         $authorized_diffs=$rel_int_tolerance;
         $observed_diffs=$diff;
       }
       else {
         $tolerance_type='Deltai<=';
         $authorized_diffs=$abs_int_tolerance;
         $observed_diffs=$diff;
       }
       if (! $diff ) {
#    print("---------> integers match\n ") ;
           $tolerance_code=11;
     return 1;
       }
       if ( $rel_int_tolerance <= 0 && $abs_int_tolerance <= 0 ) {
#    print("---------> integers are different\n ") ;
     $serious_failure = 1;
           $tolerance_code=20;
     return 0;
       }
       if ( $diff <= $abs_int_tolerance) {
#    print("---------> integers within abs tolerance\n ") ;
           $tolerance_code=21;
     return 1;
       }
       
       if ($new < $old) {$new = $old;}
       
       $tolerance_type='Deltai/Ref<=';
       $observed_diffs=$diff;
       $authorized_diffs=$rel_int_tolerance*$new;
       if ($diff <= $rel_int_tolerance*$new) {
#    print("---------> integers within tolerance\n ") ;
           $tolerance_code=31;
     return 1;
       }

      #    print("---------> integers are different\n ") ;
       $serious_failure = 1;
       $tolerance_code=30;
       return 0;

   }
   }

   if ($infinity > 0 && ( $old > $infinity || $new > $infinity ) ) {
       $tolerance_type='ValueInf>';
       $authorized_diffs=$infinity;
       $observed_diffs=$new;
   
       if ( $old == 0.0 || $new == 0.0 ) {
#    print " zero and infinity match \n" ;
           $tolerance_code=41;
     return 1;
       }
       if ( $old > $infinity && $new > $infinity ) {
#    print " infinity - infinity match \n" ;
           $tolerance_code=51;
     return 1;
       }   
   }

   # check if we have a zero value
   if ( $old <= $zero_tolerance ) {
      $tolerance_type='Value<=';
      if ($reftxt eq 'Scale') { $tolerance_type = $reftxt }
      $authorized_diffs=2*$zero_tolerance;
      $neglected_values=2*$zero_tolerance;
      $observed_diffs=$new;
      if ($new <= (2*$zero_tolerance)) {
#  print("---------> new value is within zero tolerance $zero_tolerance\n ") ;
         $tolerance_code=61;
         return 1;
      } else {
#  print("---------> new value is outside zero tolerance $zero_tolerance\n ") ;
#  print("          amount = $diff\n ") ;
   if ( $diff > $zero_fail ) {
       $zero_fail = $diff ;
   }
   $loc_zero = $diff;
         $tolerance_code=60;
   return 0;
      }

   # otherwise we use a relative tolerance   
   } else {
      # $diff = $diff / $old;
      # $rtol = $zero_tolerance / $old ;
      # if we can use the smallest tolerance
      
      # here $old is big enough (>=z/d = 0.1)
      $tolerance_type='Delta/'.$reftxt.'<=';
      $authorized_diffs=$diff_tolerance;
      $neglected_values="";
      if ( ( $zero_tolerance / $old ) <= $diff_tolerance) {
    $diff = $diff / $old;
          $observed_diffs=$diff;
    if ( $diff <= $diff_tolerance) {
#     print("---------> new value is within relative tolerance $diff_tolerance\n ") 
            $tolerance_code=71;
      return 1 ;
    } else {
#     print("---------> new value is outside relative tolerance $diff_tolerance\n ") ;
#     print("          amount = $diff\n ") ;
        if ( $diff > $rel_fail ) {
      $rel_fail = $diff ;
        }
        $loc_diff = $diff;
              $tolerance_code=70;
        return 0 ;
        
    }
# otherwise we use a weakened tolerance (to filter out noise)  
      } else {
# here the zero tolerance is more relaxed than rel_tolerance
      $tolerance_type='Delta<=';
      $authorized_diffs=$zero_tolerance;
      $observed_diffs=$diff;
      $neglected_values=$zero_tolerance;
    if ($diff <= $zero_tolerance) {
#     print("---------> new value is within relative zero tolerance $diff_tolerance\n ") ;
              $tolerance_code=81;
        return 1 ;
    } else {
#     print("---------> new value is outside relative tolerance $diff_tolerance\n ") ;
#     print("          amount = $diff\n ") ;
        if ( $diff > $zero_fail ) {
      $zero_fail = $diff ;
        }
        $loc_zero = $diff;
              $tolerance_code=80;
        return 0 ;
    }
      }
  }
}
#-----------------------
sub out_extract {
    my ($out_line);
    my ($lineno, $label, $ov, $nv, $ok) = @_;
    $out_line = "";
    $out_line .= sprintf ( "%6d%20s %$precision ->%$precision" ,
           $_[0],$_[1], $_[2], $_[3] ) ;
    if ($ok) {
      $out_line .= 
    "\n                                    ";}
    else {
      $out_line .= 
    "\n                           Failure! ";}
#    if ( $loc_zero || $loc_diff ) {
# $out_line .= sprintf ( " (%.3g %.3g)", $loc_diff, $loc_zero);
#    }
    if($debug>1){
        $out_line .= 
                  sprintf ("Tolerance_code: %s\n",$tolerance_code);
        $out_line .= "                                    ";
    }
    if ( $interval_tolerance ) {
      if ( $interval_diff ) {
        $out_line .= "*** Fail: ";
        $out_line .= 
                  sprintf ("Interval_fail, %.3g outside [%s]",$nv, $interval_tolerance);
      }
      else {
  #show requirements
  if ( $ov == $nv ) {
      $out_line .= "No change,  ";
  } else {
      $out_line .= "Acceptable, ";
  }
  $out_line .= 
            sprintf ("Interval_ok, %.3g inside [%s]",$nv, $interval_tolerance);
      }
      $out_line .="\n                                    ";
    }
    if ( $fix_tolerances == 2 ) {
      if ( $abs_diff ) {
        $out_line .= "*** Fail: ";
        $out_line .= 
                  sprintf ("Abs_fail: %.3g>%.3g",$abs_diff, 0);
      }
      else {
  #show requirements
  if ( $ov == $nv ) {
      $out_line .= "No change,  ";
  } else {
      $out_line .= "Acceptable, ";
  }
  $out_line .= 
            sprintf ("Abs_ok: <=%.3g, ",$abs_tolerance);
        
      }
      $out_line .="\n                                    ";
    }
    elsif ( $abs_tolerance ) {
      if ( $abs_diff ) {
        $out_line .= "*** Fail: ";
        $out_line .= 
                  sprintf ("Abs_fail: %.3g>%.3g",$abs_diff, $abs_tolerance);
      }
      else {
  #show requirements
  if ( $ov == $nv ) {
      $out_line .= "No change,  ";
  } else {
      $out_line .= "Acceptable, ";
  }
  $out_line .= 
            sprintf ("Abs_ok: <%.3g, ",$abs_tolerance);
        
      }
      $out_line .="\n                                    ";
    }
    if ($echo_radioss_tolerances) {
      $out_line .= 
    sprintf ("Authorized tolerance : %s%s",$tolerance_type,$authorized_diffs);
      $out_line .= 
    "\n                                    ";
      $out_line .= 
    sprintf ("Observed   tolerance : %s\n",$observed_diffs);
    }
    else {
    if ( $loc_zero || $loc_diff ) {
  # explain failure
  $out_line .= "*** Fail: ";
  if ( $loc_diff ) {
      $out_line .= 
    sprintf ("Rel_fail: %.3g>%.3g, ",$loc_diff, $diff_tolerance);
  } else {
      $out_line .= 
    sprintf ("Rel_ok: <%.3g, ",$diff_tolerance);
  }
  if ( $loc_zero ) {
      $out_line .= 
    sprintf ("Zero_fail: %.3g>%.3g, ",$loc_zero, $zero_tolerance);
  } else {
      $out_line .= 
    sprintf ("Zero_ok: <%.3g, ",$zero_tolerance);
  }
    } else {
  #show requirements
  if ( $ov == $nv ) {
      $out_line .= "No change,  ";
  } else {
      $out_line .= "Acceptable, ";
  }
  $out_line .= sprintf ( "Rel_tol=%.3g ", $diff_tolerance );
  if ( $scale ) {
      $out_line .= sprintf ( "Scale=%.5g ", $scale );
  } elsif ( $zero_tolerance ) {
      $out_line .= sprintf ( "Zero_tol=%.3g ", $zero_tolerance );
  }
  if ( $warn_tolerance ) {
      $out_line .= sprintf ("Warn_tol=%.3g ", $warn_tolerance );
  }
    }
    $out_line .= "\n";
    }
    return $out_line;
}
####################################### START TEST ########################
sub start_test {
    #prepares to start next test
#
#   init these variables before testing each qa example
#
    if ( $selfref_pass != 0 ) {
  $file_location = tell ( $infile );
  $selfref_pass = 1;
    }
      
    $xtra_args_test       ="";
    $del_suffix_extract   = 0;
    $use_which_extract    = 1;
    $within_else          = 0;
    $after_execute        = 0;
    $has_bad_example      = 0;
    $extractinif          = 0;
    $have_extract2        = 0;
    $clean_local_file     = 1;
 
    $fem_file = "" ;
    $fem_file_path = "" ;
    $listing_file = "";
    $diff_buffer = "";
    @alternate_extract_file = () ;
    @h3dfiles    = () ; 
    @h3d_extract_file =();
    $infinity = 0;
    @local_keywords = ('all');
    @p4_local_files = ();
    @orig_extract1 = ();
    @new_extract1 = ();

    my $sensitivity_report=0;
    if ( $sensitivity == 1 ) {
      if ($test_id and $test_id > 0) {
        if ( $sensitivity_cur_n < $sensitivity_n ) {
          if ( (($required_example eq "" )
               or ( $full_test_id eq $required_example )) 
               and ( not ( $skip_this_multi_test == 1) ) ) {
              if ($test_id and $test_id > 0) {
                print "=> Iteration $sensitivity_cur_n.\n";
              }
          }
          seek ( $infile, $test_start_location, 0 );
          $test_id--;
          $sensitivity_cur_n++;
        }
        else {
          if ( (($required_example eq "" )
               or ( $full_test_id eq $required_example )) 
               and ( not ( $skip_this_multi_test == 1) ) ) {
              if ($test_id and $test_id > 0) {
                print "=> Iteration $sensitivity_cur_n.\n";
              }
          }
          $sensitivity_report=1;
          $sensitivity_cur_n=0;
        }
      }
    }
    if ( (($required_example eq "" )
         or ( $full_test_id eq $required_example )) 
         and ( not ( $skip_this_multi_test == 1) ) ) {
        if ($test_id and $test_id > 0 and $sensitivity_report==1) {
            &sensitivity_report();
            $sensitivity_report=0;
        }
        if ($keep_results == 1) { system("touch .test-start");sleep(1); }    
    }
    $extract_file = "" ;
    $original_extract_file = "" ;

    $test_id++;
    if ( $in_include > 0 ) {
  $full_test_id = "$include_file_id".".$test_id" ;
  $dot_test_id = "$include_file_id"."[.]$test_id"
    } else {
  $full_test_id = "$test_id" ;
  $dot_test_id = "123456" ; # cant skip with single digit numbers
    }
    # dot_test_id is needed to compare with skip list - regexp messes with dot.
    
    $skip_this_multi_test = 0;
    $not_skipping = 1;
    if ( ( $required_example ne "" )
   && ( $full_test_id ne $required_example ) ) {
      $not_skipping = 0;
  }
    
    $prog_args = "" ;
    if ( ! $use_reset_tolerances ) {
  $zero_tolerance = $zero_tolerance_orig ;
  $diff_tolerance = $diff_tolerance_orig ;
  $warn_tolerance = $warn_tolerance_orig ;
  $scale_factor_delta_vs_emax = $scale_factor_delta_vs_emax_orig ;
  $scale_factor_emax = scale_factor_emax_orig;
    }
## abs and local tolerances are only local
    $abs_tolerance=0;
    $interval_tolerance="";
##########################################
    # XXXXXX Sensibility New QA doesn't ignore commented tests whereas New QA does
    # We always assume that mark_label is defined for all test, because forcing it to bb
    # Will make the sensibility iterations > 0 to run even for a commented test
    # $mark_label = 'bb' ; # default if no mark is set for the example
    $out_buffer = "" ;

    $force_fail = 0; # set to 1 if there is no way to run example
    @file_check = () ; # list of file commands (delayed after go)
    @to_copy = ();     # list of files to copy (delayed till go)
    if ( $#stack_local >= 0 ) {
  @stack_local = (); # saves 'local varname' data
  if ( $#stack_global ) { $has_stack = 1 ; }
    }
    if ( $#match_local >= 0 ) {
  @match_local = (); # saves 'local' varname Match
  if ( $#match_global ) { $has_match = 1 ; }
    }
    $skip_becse_require = ""; #clean require file of last test
}
###########################################################################
#-----------------------
sub sensitivity_report {
    my %report=();
    my %report_form=();
    for ($i=0;$i<$sensitivity_n+1;$i++) {
        my $file=$full_test_id."_".$extract_file."_".$i;
#        if ($i==0) {$file=$original_extract_file}
        if (-f $file ) {
            open(my $fh,$file) || print "Cannot open file $file !\n";
            my @tmp=<$fh>;close($fh);
            my $index=0;
            for (@tmp) {
                $_=~ s/\t/ /;
                my @fields=split(' ',$_);
                if ($i==0) {
                   push @{$report_form{$fields[0]}},$fields[1];
                }
                push @{$report{$fields[1]}},$fields[2];
                $index++;
            }
        }
#         else { print "Cannot open file $file !\n" }
    }
    print "Sensitivity report [ ".$sensitivity_n." , ".$sensitivity_xalea." ] :\n";
    my $extract_file_sens="";
    my $extract_file_sens_report_basic="";
    my $extract_file_sens_report_advanced="";
    my $tolerances="";
    my $diff_tolerances="";
    my $mindex=int($sensitivity_n/2);
    my $mindex1=$mindex+1;
    my $meds='med='.$mindex1;
    my $i_first=0;

    # For each element
    for (sort {$a <=> $b} keys %report_form) {
        my $index=$_;
        my $key=$report_form{$index}[0];
        my $average=0;
        my $count=-1;
        my $stddev=0;
        my $over_stddev="";
        my $over_stddevn=0;
        my $perc_minmax_stddev=0;
        my $min=$report{$key}[1];
        my $max=$report{$key}[1];
        my $imin=1;
        my $imax=1;
        if ($i_first == 0) { $i_first++; next }
        if (grep {$_ eq 'nan'} @{$report{$key}}) {
          print "Error : nan in key : $key\n"; 
          next;
        } 
        for (@{$report{$key}}) {
          my $value=$_;
          $count++;
          if ($count > 0) {
            $average+=$value+0;
            if ($value>$max) {$max=$value;$imax=$count;}
            if ($value<$min) {$min=$value;$imin=$count;}
          }
        }
        if ($count > 0) {$average=$average/$count};
        $count=-1;
        my $blank=' ' x length($key);
        for (@{$report{$key}}) {
          my $value=$_;
          $count++;
          if ($count > 0) {
            $stddev+=abs($value-$average)+0;
          }
        }
        if ($count > 0) {$stddev=$stddev/$count};
        my $inter=$max-$min;
        my $ind_tmp=1;
#         print join(':',@{$report{$key}});
#         print "\n";
        my @search_med=map { $ind_tmp++.":".$_ } @{$report{$key}};
#         print join(':',@search_med);
#         print "\n";
        my @search_med_sorted=sort {(split(':',$a))[1] <=> (split(':',$b))[1] } @search_med;
#         print join(':',@search_med_sorted);
#         print "\n";
        
        my $median=(sort {$a <=> $b} @{$report{$key}})[$mindex];
        my $imed=(split(':',$search_med_sorted[$mindex]))[0];
#        my $median=(sort {$a <=> $b} @{$report{$key}})[$mindex];
#        my @tri = sort { $a->[2] <=> $b->[2] } @tab; 
        $count=-1;
        for (@{$report{$key}}) {
          my $value=$_;$count++;
          if ($count > 0) {
            if (abs($value-$median)>$stddev) {$over_stddevn++;$over_stddev.=$count.",";}
          }
        }
        if (length($over_stddev) > 0) {$over_stddev=substr($over_stddev,0,length($over_stddev)-1);}
        if (not $over_stddev) {$over_stddev="none";}
        if ($stddev > 0) {$perc_minmax_stddev=100*$inter/$stddev};
        my $tmp_buf=sprintf ("%6d%20s %$precision\n",
                 $_,$key, $median );
        my $tmp_buf1="";
        $extract_file_sens.=$tmp_buf;
        my $perc_value=-1;if (abs($median) > 0) {$perc_value=abs(100*($max-$min)/$median);}
        $tmp_buf=sprintf ("%6d%20s %$precision %$precision %$precision %$precision %$precision %c\n" ,
                          $_,$key  ,$median     ,$min        ,$max        ,$max-$min   ,$perc_value,37) ;
        $tmp_buf1=sprintf ("%6d%20s %$precision %5d %$precision %$precision %5d %$precision %5d %$precision %$precision %$precision %c %$precision %c %6d %$precision_s\n" ,
                          $_,$key  ,$median     ,$imed     , $average   ,$min        ,$imin        ,$max        ,$imax        ,$stddev     ,$max-$min   ,$perc_value,37,$perc_minmax_stddev,37,$over_stddevn,$over_stddev ) ;
        if (abs($max-$min) > 0) {
          if ($key ne 'ELTID') {
            my $max_abs=abs($max);if (abs($min) > $max_abs) {$max_abs=abs($min)}
            $max_abs=$max_abs+abs($max-$min);
            if (! $no_check_emax and %extract_ref_values) {

              if  ($key eq 'IENERGY' or $key eq 'KENERGYT' or $key eq 'KENERGYR' or $key eq 'EXTWORK') {
                my $calc = abs($max-$min);
                print "\n#################################################################\n" if ($dbgout);
                print "KEY=$key :\n" if ($dbgout);
                
                print "\t --- Checking if reference < Emax*scale_factor_emax ($extract_ref_values{$key} < $extract_ref_values{'emax'}*$scale_factor_emax)\n" if ($dbgout);
                if ($scale_factor_emax and $extract_ref_values{$key} < $extract_ref_values{'emax'}*$scale_factor_emax) {
                  print "\t --- YES\n" if ($dbgout);
                  print "\t\t --- Checking if diff < Emax*scale_factor_delta_vs_emax ($calc < $extract_ref_values{'emax'}*$scale_factor_delta_vs_emax)\n" if ($dbgout);
                  if ($scale_factor_delta_vs_emax and abs($max-$min) < $extract_ref_values{'emax'}*$scale_factor_delta_vs_emax) {
                    print "\t\t --- YES, ignoring the DIFF and the tolerance!!!\n" if ($dbgout);
                    printf "Variable tolerance $key (%.5g) lower than Emax criteria=Scale_Factor_Delta_Vs_Emax*Emax(%.5g) : tolerance ignored !\n",abs($max-$min),$extract_ref_values{'emax'}*$scale_factor_delta_vs_emax;
                  }
                  else {
                    print "\t\t --- NO\n" if ($dbgout);
                    if ($perc_value < 0) {
                    $tolerances.=sprintf("%-s\t%s\tAbs_Tolerance\t%s\n",'local',$key,abs($max-$min));
                    }
                    else {
                    $diff_tolerances.=sprintf("%-s\t%s\tDiff_Tolerance\t%s\n",'local',$key,$perc_value/100);
                  }
                }
                }
                else { 
                  print "\t --- NO\n" if ($dbgout);
                  if ($perc_value < 0) {
                  $tolerances.=sprintf("%-s\t%s\tAbs_Tolerance\t%s\n",'local',$key,abs($max-$min));
                  }
                  else {
                  $diff_tolerances.=sprintf("%-s\t%s\tDiff_Tolerance\t%s\n",'local',$key,$perc_value/100);
                }
              }
              }

              # For CYCLE key we use Int_Tolerance (Diff_Tolerance is not allowed for integer values)
              elsif ($key eq 'CYCLE') {
                 $diff_tolerances.=sprintf("%-s\t%s\tInt_Tolerance\t%s\n",'local',$key,abs($max-$min));                  
              }
              else {
                if ($perc_value < 0) {
                 $tolerances.=sprintf("%-s\t%s\tAbs_Tolerance\t%s\n",'local',$key,abs($max-$min));
                }
                else {
                 $diff_tolerances.=sprintf("%-s\t%s\tDiff_Tolerance\t%s\n",'local',$key,$perc_value/100);
                }
              }
            }
            else {
              # For CYCLE key we use Int_Tolerance (Diff_Tolerance is not allowed for integer values)
              if ($key eq 'CYCLE') {
                 $diff_tolerances.=sprintf("%-s\t%s\tInt_Tolerance\t%s\n",'local',$key,abs($max-$min));                  
              }
              else {
                if ($perc_value < 0) {
                $tolerances.=sprintf("%-s\t%s\tAbs_Tolerance\t%s\n",'local',$key,abs($max-$min));
                }
                else {
                $diff_tolerances.=sprintf("%-s\t%s\tDiff_Tolerance\t%s\n",'local',$key,$perc_value/100);
              }
            }
          }
        }
        }
        $extract_file_sens_report_basic.=$tmp_buf;
        $extract_file_sens_report_advanced.=$tmp_buf1;
    }
    print "\n\tRecommended extract file ($meds) :\n";
    print $extract_file_sens;
#    print "\tRecommended tolerances :\n";
#    (abs(max-min))
#    print $tolerances;
    print "\n\tRecommended tolerances :\n";
    #(max-min)/med
  # diff tolerance = perc_value/100 = abs(($max-$min)/$median)
  # QA file needs relative value, not percentage one
    print $tolerances;
    print $diff_tolerances;
    print "\n\tExtract statistics (basic):\n";
    my $precision_l2=$precision_l+2;
    my $precision_s2=$precision_l2."s";
    $extract_file_sens_report_title=
                 sprintf ("%6s%20s %$precision_s2 %$precision_s2 %$precision_s2 %$precision_s2   %$precision_s2\n" ,
                             '','' ,$meds                ,'min'               ,'max'                 ,'tol=max-min'        ,'tol%(value)') ;
    print $extract_file_sens_report_title;
    print $extract_file_sens_report_basic;

    print "\tExtract file statistics (advanced):\n";
    $extract_file_sens_report_title1=
                 sprintf ("\t%s\n",'(* values outside med+-stddev)');
    $extract_file_sens_report_title1.=
                 sprintf ("%6s%20s %$precision_s2 %5s %$precision_s2 %$precision_s2 %5s %$precision_s2".
                          " %5s %$precision_s2 %$precision_s2   %$precision_s2   %$precision_s2 %6s %$precision_s\n" ,
                             '','' ,$meds         ,'imed'    ,'average'              ,'min'       ,'imin'  ,'max' ,
                          'imax' ,'stddev'  ,'tol=max-min' ,'tol%(value)','tol%(stddev)' ,'Nover*','Iterations*') ;
    print $extract_file_sens_report_title1;
    print $extract_file_sens_report_advanced;

    my $extract_file_sampling_datas="";
    print "\tSampling datas :\n";
    $extract_file_sampling_datas.=sprintf("[%s%s]\n","Xalea=",$sensitivity_xalea);
    $extract_file_sampling_datas.=sprintf("%6s%20s","Id","Seed");
    for (sort {$a <=> $b} keys %report_form) {
      $extract_file_sampling_datas.=sprintf("%$precision_s",$report_form{$_}[0]);
    }
    $extract_file_sampling_datas.=sprintf("\n");
    my @report_out=();
    my $index=0;
    for (sort {$a <=> $b} keys %report_form) {
      my $key=$report_form{$_}[0];
      my $count=-1;
      for (@{$report{$key}}) {
        my $value=$_;
        $count++;
        if ($index == 0) {
          $report_out[$count].=sprintf("%6d%20s",$count,$count/$sensitivity_n);
        }
        $report_out[$count].=sprintf("%$precision_s",$value);
      }
      $index++;
    }
    for ( @report_out ) {
      if ($_) {$extract_file_sampling_datas.=sprintf("$_ \n");}
    }
    $extract_file_sampling_datas.=sprintf("\n");
    print $extract_file_sampling_datas;
#     for (@report_tab) {
#       print $extract_file_sampling_title;
#       print $extract_file_sampling_data;
#       print "\n";
#       print join(',',@{$_});
#       print "\n";
#     }
#  @report_tab
#  [Start]   1   val1  val2  val3 ...
#  ...       i   val1  val2  val3 ...
#  [Stop]    n   val1  val2  val3 ...

    my @tab_output=();
    my $glob_index=0;
    for (@report_tab) {
      for (@report_tab) {
        my @tmp=@{$_};
        if ($glob_index == 0) {
          for (@tmp) {
            $tab_output[$glob_index].=sprintf("%6d",$glob_index+1);
            $index++;
          }
        }
        else {
          for (@tmp) {
            $tab_output[$glob_index].=sprintf("%$precision_s",$_[$glob_index]);
          }
        }
      }
      $glob_index++;
    }
#     printf $extract_file_sampling_data,
    my $file=$full_test_id."_".$extract_file."_sens";
    open(my $fh,">$file");
    print $fh $extract_file_sens;
    close($fh);

    my $stat_file=&preserve_1_file ($file, $saved_files_dir, $qa_fem_files_file, "sens") ;
    &out_file("Stat file :  $stat_file created.\n");
    $file=$full_test_id."_".$extract_file."_sens_stats";
    open($fh,">$file");
    print $fh "Tolerances :\n";
    print $fh "$tolerances\n";
    print $fh "Diff Tolerances :\n";
    print $fh "$diff_tolerances\n";
    print $fh "Statistics (basic):\n";
    print $fh $extract_file_sens_report_title;
    print $fh $extract_file_sens_report_basic;
    print $fh "Statistics (advanced):\n";
    print $fh $extract_file_sens_report_title1;
    print $fh $extract_file_sens_report_advanced;
    close($fh);
    $stat_file=&preserve_1_file ($file, $saved_files_dir, $qa_fem_files_file, "sens_stats") ;
    my $stat_file_sens_stats = $stat_file;
    &out_file("Stat file :  $stat_file created.\n");
    $file=$full_test_id."_".$extract_file."_sens_sampling_datas";
    open($fh,">$file");
    print $fh $extract_file_sampling_datas;
    close($fh);
    $stat_file=&preserve_1_file ($file, $saved_files_dir, $qa_fem_files_file, "sens_sampling_datas") ; 
    my $stat_file_sens_sampling = $stat_file;
    &out_file("Stat file :  $stat_file created.\n");

    # XXXXXX Add tolerance for all model (provide automatic way to do it from qa_script)
    # Add tolerances into the qafile content's array
    if ($sensitivity_set_recommended_tolerances) {
      print "\n\n--------- AUTOMATED TOLERANCE INSERTION (test $full_test_id) : Check for insertion\n\n";

      if ( (defined $diff_tolerances and $diff_tolerances !~ /^ *$/) or (defined $tolerances and $tolerances !~ /^ *$/) ) {
        my $auto_insert = 1;

        my %extract_result;

        # Store ELEMENT => type diff and value
        my @tab_extract_recommended;
        push (@tab_extract_recommended, split("\n",$diff_tolerances)) if (defined $diff_tolerances);
        push (@tab_extract_recommended, split("\n",$tolerances)) if (defined $tolerances);
        for my $elem_reco (@tab_extract_recommended) {
          my @line_elems = split(" ",$elem_reco);
          $extract_result{$line_elems[1]} = { type_diff => $line_elems[2], value_diff => $line_elems[3] };

        }

        # Store ELEMENT => percent of diff for constraints check
        my @tab_extract_result = split("\n",$extract_file_sens_report_basic);
        for my $elem_stats (@tab_extract_result) {
          my @line_elems = split(" ",$elem_stats);
          # We store the percent only for recommended diffs
          if (defined $extract_result{$line_elems[1]}) {
                $extract_result{$line_elems[1]}{'percent'} = $line_elems[6];
          }
        }

        # print "---------\%extract_result---------\n";
        # print Dumper %extract_result;
        # print "---------\%sensitivity_contraints---------\n";
        # print Dumper %sensitivity_contraints;
        # print "------------------------------\n";

        my @msg_aborted;

        # Read each recommended tolerance
        for my $elem (keys %extract_result) {
          # Check if it respects our constraints
          if (! $sensitivity_no_constraint and defined $sensitivity_contraints{$elem} and $sensitivity_contraints{$elem} ne '') {
            if ($extract_result{$elem}{'percent'} > $sensitivity_contraints{$elem}) {
              my $temp_msg_aborted = $elem." : ".$extract_result{$elem}{'percent'}." % (recommended) > ".$sensitivity_contraints{$elem}." % (constraint)";
              push(@{$sensitivity_test_alert_email_abort{$full_test_id}{'msg'}},$temp_msg_aborted);
              push (@msg_aborted,$temp_msg_aborted);
              $sensitivity_test_alert_email_abort{$full_test_id}{'Input_path'} = $tests_infos{$full_test_id}{'Input_path'};
              $auto_insert = 0; 
            }
          }
        }

        # Check several cases when there are already tolerances in or_QA.files
        if ($auto_insert) {

          # Get the already present tolerances (old) for this test
          my %old_tolerances;
          my $flag_found_test = 0;
          my $regexp = '^#'.$full_test_id.'$';
          for my $line (@qafile_current) {
            $flag_found_test == 0 and $line =~ /$regexp/ and do {
              $flag_found_test = 1;
              next;
            };

            $flag_found_test == 1 and $line =~ /^(go -engine.*)/ and do {
              last;
            };

            $flag_found_test == 1 and $line =~ /^\s*local\s+/ and do {
              
              my @temp = split(/\s+/,$line);
              $old_tolerances{$temp[1]} = { type_diff => $temp[2], value_diff => $temp[3] };
            };
          }

          # print "---------\%old_tolerances---------\n";
          # print Dumper %old_tolerances;
          # print "------------------------------\n";

          if ($auto_insert) {
            # Consider we don't insert, and set it to 1 if there is at least one new thing to add/change
            $auto_insert = 0;
    
            # If a proposed tolerance is over this limit, we add it but we warn by email
            my $qa_percent_warns = 50;

            # If there are already new proposed tolerances
            if (scalar(keys %extract_result)) {
              # We browse the them and look for a related recommended one in the old
              for my $elem (keys %extract_result) {
                # If the exact same item (CYCLE, TSTEP) is exit as old tolerance
                if (defined $old_tolerances{$elem}) {
                  # If the old and new tolerances have the same type Diff
                  if ($extract_result{$elem}{'type_diff'} eq $old_tolerances{$elem}{'type_diff'}) {
                    # If the new tolerance is <= old, we don't overwrite old with new + WARNING by MAIL, we keep it
                    if ($extract_result{$elem}{'value_diff'} <= $old_tolerances{$elem}{'value_diff'}) {
                      my $msg = $elem." : ".$extract_result{$elem}{'value_diff'}." (recommended) <= ".$old_tolerances{$elem}{'value_diff'}." (old previous)  | keeping old value";
                      print "Info : $msg\n";
                      # A way to keep the old value is to set it in extract_result (the hash used to write new tolerances)
                      $extract_result{$elem}{'value_diff'} = $old_tolerances{$elem}{'value_diff'};
                    }
                    else {
                      $auto_insert = 1;
                      # Checking if proposed tolerance is > 50% => warning
                      if ($extract_result{$elem}{'percent'} >= $qa_percent_warns) {
                        my $msg = $elem." : ".$extract_result{$elem}{'type_diff'}." ".$extract_result{$elem}{'percent'}."% (recommended) is >= ".$qa_percent_warns."% | adding it but warns";
                        print "Warning : $msg\n";
                        push(@{$sensitivity_test_alert_email_warnings{$full_test_id}{'msg'}},$msg);
                        $sensitivity_test_alert_email_warnings{$full_test_id}{'Input_path'} = $tests_infos{$full_test_id}{'Input_path'};
                        $qafile_must_alert_by_mail = 1;
                      }
                    }
                  }
                  # Else we can't compare, we overwrite old with new + WARNING by MAIL
                  else {
                    my $msg = $elem." : ".$extract_result{$elem}{'type_diff'}." (recommended) != ".$old_tolerances{$elem}{'type_diff'}." (old previous)  | type differs, overwriting old value with recommended";
                    print "Warning : $msg\n";
                    push(@{$sensitivity_test_alert_email_warnings{$full_test_id}{'msg'}},$msg);
                    $sensitivity_test_alert_email_warnings{$full_test_id}{'Input_path'} = $tests_infos{$full_test_id}{'Input_path'};
                    $qafile_must_alert_by_mail = 1;
                    $auto_insert = 1;
                    # Checking if proposed tolerance is > 50% => warning
                    if ($extract_result{$elem}{'percent'} >= $qa_percent_warns) {
                      $msg = $elem." : ".$extract_result{$elem}{'type_diff'}." ".$extract_result{$elem}{'percent'}."% (recommended) is >= ".$qa_percent_warns."% | adding it but warns";
                      print "Warning : $msg\n";
                      push(@{$sensitivity_test_alert_email_warnings{$full_test_id}{'msg'}},$msg);
                    }                
                  }
                }
                else {
                  # Else (no old tolerance, normal insert)
                  $auto_insert = 1;
                  # Checking if proposed tolerance is > 50% => warning
                  if ($extract_result{$elem}{'percent'} >= $qa_percent_warns) {
                    my $msg = $elem." : ".$extract_result{$elem}{'type_diff'}." ".$extract_result{$elem}{'percent'}."% (recommended) is >= ".$qa_percent_warns."% | adding it but warns";
                    print "Warning : $msg\n";
                    push(@{$sensitivity_test_alert_email_warnings{$full_test_id}{'msg'}},$msg);
                    $sensitivity_test_alert_email_warnings{$full_test_id}{'Input_path'} = $tests_infos{$full_test_id}{'Input_path'};
                    $qafile_must_alert_by_mail = 1;
                  }
                }
              }
            }

            # We must also cover the case where an old tolerance doesn't exist in proposed tolerance (and auto_insert = 1), we will lose this value
            # So we need to detect this case and keep the old tolerance
            if ($auto_insert and scalar(keys %old_tolerances)) {
              my @keys_new = keys (%extract_result);

              # We browse the old ones and look for a related recommended one
              for my $elem (keys %old_tolerances) {
                if (!grep(/^$elem$/,@keys_new)) {
                  $extract_result{$elem} = $old_tolerances{$elem};
                }
              }
            }
          }
        }

        # If there is some warnings, we add detail in an attached file for email
        if (scalar(keys %sensitivity_test_alert_email_warnings)) {
          # Fill a file with sensitivity result in the way to attach it to the mail
          system("echo -e \"\n\n================= Test $full_test_id =================\n\" >> $sensitivity_stats_for_email");
          system("cat $stat_file_sens_stats $stat_file_sens_sampling >> $sensitivity_stats_for_email"); 
        }

        # print "---------\%extract_result---------\n";
        # print Dumper %extract_result;
        # print "------------------------------\n";

        # If all constraints are respected we auto fill the or_QA.files
        if ($auto_insert) {
          print "\n\tInsertion allowed\n";

          $qafile_must_be_rewritten = 1;

          my $flag_found_test = 0;
          my $flag_inserted_new_tol = 0;
          my $regexp = '^#'.$full_test_id.'$';
          my @output;
          foreach my $line (@qafile_current)
          {

            $flag_found_test == 0 and $line =~ /$regexp/ and do {
              $flag_found_test = 1;
              push(@output,$line);
              next;
            };

            $flag_found_test == 1 and ($line =~ /^(go -engine.*)/ or $line =~ /^(if precision\s*==\s*sp\s+local.*)/) and do {
              
              if (!$flag_inserted_new_tol) {
                $flag_inserted_new_tol = 1;
              # Insert new diff recommended lines
              for my $elem (keys %extract_result) {
                  push(@output,"local\t".$elem."\t".$extract_result{$elem}{'type_diff'}."\t".$extract_result{$elem}{'value_diff'}."\n");
              }
              }
              push(@output,$1."\n");

              if ($line =~ /^(go -engine.*)/) { $flag_found_test = 0; }
              next;
            };

            $flag_found_test == 1 and $line =~ /^\s*local\s+/ and do {
              next; # we don't recopy the old tolerance => overwrite with new ones
            };

            # Recopy all other lines
            push(@output,$line);
          }
          @qafile_current = @output;
          $sensitivity_cpts{'inserted'}++;
        }
        else {
          if (scalar(@msg_aborted)) {
            for my $elem (@msg_aborted) {
              print "Error : $elem\n";
            }
            print "\nInsertion aborted ...\n";
            $sensitivity_cpts{'aborted'}++;          
            $qafile_must_alert_by_mail = 1;

            # Fill a file with sensitivity result in the way to attach it to the mail
            system("echo -e \"\n\n================= Test $full_test_id =================\n\" >> $sensitivity_stats_for_email");
            system("cat $stat_file_sens_stats $stat_file_sens_sampling >> $sensitivity_stats_for_email");
          }
          else {
            print "\n\tNothing to be inserted\n";
            $sensitivity_cpts{'empty'}++;
          }
        }
      }
      else {           
        print "\tNothing to be inserted\n";
        $sensitivity_cpts{'empty'}++;
      }
      print "\n\n--------- END AUTOMATED TOLERANCE INSERTION (test $full_test_id) : Check for insertion\n\n";
    }  
    
}
sub out_file {
       print         @_ ;
       print SUMMARY @_ ;
       print PARASUM @_ if ( $parasumopen );
}
#-----------------------
sub out_line {
    my $tt = "---------------------------------------------------------------------------\n" ;
    print $tt ; 
    print SUMMARY $tt ;
}
#-----------------------
sub get_next_list_id {
    # extract next FILE/ID from argument
    $tmp_list = $_[0] ;
    if ( substr ( $tmp_list, 0, 1 ) eq "-" ) {
  $tmp_list = substr ( $tmp_list, 1 );
    }
    $cur_list = "" ;
    $tmp1 = index($tmp_list, ",");
    if ( $tmp1 > 0 ) {
  $list_start = substr( $tmp_list, 0, $tmp1) ;
  $cur_list = substr( $tmp_list, $tmp1+1 ); # delete ','
    } else {
  $list_start = $tmp_list;
    }
    $tmp2 = index($list_start, "-");
    if ( $tmp2 > 0 ) {
  $list_start = substr( $list_start, 0, $tmp2 ) ;
  $cur_list = substr( $tmp_list, $tmp2 ); # keep '-'
    }

    $tmp1 = index($list_start, ".");
    if ( $tmp1 > 0 ) {
  $list_fil = substr($list_start, 0, $tmp1);
  $list_id = substr($list_start, $tmp1+1);
    } else {
  $list_id = $list_start;
  $list_fil = "0";
    }

}   
##########################################################################
sub preserve_files {

# After each failure, following files are preserved:
##  Screen_Output/     stdout/stderr of the job
##  Extracted_data/    failed extract file
##  Output_files/
# The above files are also saved if --save_out_files flag is used
# When $save_folder is specified, then location is back in database:
#  as  [file path input_file]/$save_folder/

# Following directory is used to save files designated with 'file save'
##  Saved_files/

    local(@ls,$file,$pat,$ff);
    
    $preserve_suffix = "QA_" . $full_test_id;
    if (substr($preserve_suffix,4,1) eq '.' ) {
  $preserve_suffix = "QA_0" . $full_test_id;
    }
    my ($o_dir, $s_dir, $e_dir);
    if ( $save_folder ) {
  my $path = &mksavepath ;
  $o_dir = $path ;
  $s_dir = $path ; 
        $e_dir = $path ;
    } else {
  $o_dir = $out_files_dir ;
  $s_dir = $screen_output_dir ; 
        $e_dir = $extracted_data_dir ;
    }
    
    if (-f $extract_file) {
  &preserve_1_file ($extract_file, $e_dir, "" );
    }
    if (-f $qa_screen) {
  &preserve_1_file ($qa_screen, $s_dir, "out", $root) ;
    } else {
  # create empty output file (needed for opt-compile-fix)
  system ("touch", $qa_screen) ;
  &preserve_1_file ($qa_screen, $s_dir, "out", $root) ;
    }
    if ( $#save_ext >= 0 ) {
        @ls = qx/ls/ ;
#        print( "Files:\n@ls\n" );
#        print( "Patterns: @save_ext\n");
#        print( "Delete: @to_delete\n");
        NEXTFILE: foreach $file ( @ls ) {
            foreach $pat ( @save_ext ) {
                if ( $file =~ /$pat/ ) {
                     chomp($file);
#                    print("Saving: $file\n");
# filter out files which are input or copied
                     foreach $ff (@to_delete) {
                         if ( $file =~ /$ff/ ) { next NEXTFILE; }
                     }
         &preserve_1_file ( $file, $o_dir,  "save");
                     next NEXTFILE;
                }
            }
  }
    }
}
########################################################
sub preserve_1_file {
    # usage: &preserve_1_file file folder suffix <newname>
    local ($fname,$fdir,$newname,$suffix,$preserve_suffix);
    $fname  = $_[0];
    $fdir   = $_[1];
    $suffix = $_[2];
    $preserve_suffix = "QA_" . $full_test_id;
    if (substr($preserve_suffix,4,1) eq '.' ) {
  $preserve_suffix = "QA_0" . $full_test_id;
    }
    if ( $_[3] ) {
  $newname = $fdir . "/$preserve_suffix" . "_$_[3]" . "_$suffix" ;
    } else {
  $newname = $fdir . "/$preserve_suffix" . "_$fname" . "_$suffix" ;
    }
    if ( -f $newname ) { unlink ($newname) ; }
#   print "Renaming $fname, $newname\n";
    if ( ! rename ( $fname, $newname ) ) {
  if ( -f $fname ) {
      sleep 2;
      if ( -f $fname ) {
    if ( ! system ("mv", $fname, $newname ) ) {
        &out_file("Could not preserve failure file ".
            "$fname -> $newname\n\t$!\n") ;
        system ( "ls -ld $fname $fdir" ) ;
        if ( -f $newname ) { system ( "ls -ld $newname" ) ; }
    }
      }
  }
    }
  return $newname;

}
##########################################################################
sub mksavepath {
    my $path = $fem_file;
    $path =~ s/[^\/\\]*$// ;
    $path .= $save_folder ;
    #  print "$fem_file $path \n" ;
    if ( ! -d $path ) {
  mkdir $path,0777 ; }
    return $path;
}
##########################################################################
sub check_names_match {
    
    if ( $fix_tolerances ) { return ; }
    
    foreach $ii ( @match_local ) {
  if ( $new_variable !~ /^$ii/ ) { next ; }
  if ( $orig_variable !~ /^$ii/ ) { next ; }
  $tmp3 = $ii;
  goto MATCH;
    }
    foreach $ii ( @match_global ) {
  if ( $new_variable !~ /^$ii/ ) { next ; }
  if ( $orig_variable !~ /^$ii/ ) { next ; }
  $tmp3 = $ii;
  goto MATCH;
    }
    return;

  MATCH:

    $tmp = length($tmp3);
    $tmp1 = substr($orig_variable,$tmp);
    $tmp2 = substr($new_variable,$tmp);
    if ( $tmp1 ne "" && $tmp2 ne "" && substr($orig_variable,0,$tmp) eq $tmp3) {
  $out_buffer .= " MATCH: $new_number $tmp3\{$tmp1->$tmp2\}" ;
    } else {
  $out_buffer .= " MATCH as $tmp3: $new_number ($orig_variable->$new_variable)" ;
    }
    if ( $orig_value == $new_value ) {
  $out_buffer .= " $orig_value\n" ;
    } else {
  $out_buffer .= " ($orig_value->$new_value)\n" ;
    }
    $new_variable = $tmp3 ;
    $orig_variable = $tmp3 ;
    return;
    
}
##########################################################################
sub save_tol {
    my ($set)=@_;
    my @tmp_tol=( $diff_tolerance, $zero_tolerance, $warn_tolerance, $rel_int_tolerance, $abs_int_tolerance, $infinity, $biggest_int, $abs_tolerance, $interval_tolerance);
    if ($set) {
      $tol_set{$set}= \@tmp_tol; }
    else {
      @tol_save = @tmp_tol ; }
}
##########################################################################
sub get_tol {
    my ($set)=@_;
    my @tmp_tol=();
    if ($set) {
      @tmp_tol = @{$tol_set{$set}}; }
    else {
      @tmp_tol=@tol_save ; }
    ( $diff_tolerance, $zero_tolerance, $warn_tolerance,  $rel_int_tolerance, $abs_int_tolerance, $infinity, $biggest_int, $abs_tolerance, $interval_tolerance)  = @tmp_tol ;
}
##########################################################################
sub print_tol {
    my ($set)=@_;
    my @tmp_tol=();
    if ($set) {
      @tmp_tol = @{$tol_set{$set}}; }
    else {
      @tmp_tol=@tol_save ; }
    my ( $diff_tolerance, $zero_tolerance, $warn_tolerance,  $rel_int_tolerance, $abs_int_tolerance, $infinity, $biggest_int, $abs_tolerance, $interval_tolerance)  = @tmp_tol ;
    my @tmp_print=( "diff_tolerance=$diff_tolerance", "zero_tolerance=$zero_tolerance", "warn_tolerance=$warn_tolerance",  "rel_int_tolerance=$rel_int_tolerance", "abs_int_tolerance=$abs_int_tolerance", "infinity=$infinity", "biggest_int=$biggest_int", "abs_tolerance=$abs_tolerance", "interval_tolerance=$interval_tolerance");
    my $sep='-'x30;
    &out_file($sep."\n".join("\n",@tmp_print)."\n".$sep."\n"); 
}
##########################################################################
sub change_tol {
    local ($namevar, $val_tol);
    $namevar = $_[0] ;
    $val_tol = $_[1] ;
    if ( $namevar eq "Diff_Tolerance" ) {
  $diff_tolerance = $val_tol ;
  if ( $val_tol eq "NONE" ) { $diff_tolerance = $tol_save[0] ; }
    } elsif ( $namevar eq "Relative_Int_Tolerance" ) {
  $rel_int_tolerance = $val_tol ;
  if ( $val_tol eq "NONE" ) { $rel_int_tolerance = $tol_save[2] ; }
    } elsif ( $namevar eq "Zero_Tolerance" ) {
  $zero_tolerance = $val_tol ;
  if ( $val_tol eq "NONE" ) { $zero_tolerance = $tol_save[1] ; }
    } elsif ( $namevar eq "Int_Tolerance" ) {
  $abs_int_tolerance = $val_tol ;
  if ( $val_tol eq "NONE" ) { $abs_int_tolerance = $tol_save[3] ; }
    } elsif ( $namevar eq "Infinity" ) {
  $infinity = $val_tol ;
  if ( $val_tol eq "NONE" ) { $infinity = $tol_save[4] ; }
    } elsif ( $namevar eq "Max_Integer" ) {
  $biggest_int = $val_tol ;
  if ( $val_tol eq "NONE" ) { $biggest_int = $tol_save[5] ; }
    } elsif ( $namevar eq "Use_Abs_Values" ) {
  $use_abs_values = 1;
    } elsif ( $namevar eq "Abs_Tolerance") {
        $abs_tolerance = $val_tol ;
    } elsif ( $namevar eq "Interval_Tolerance") {
        $interval_tolerance = $val_tol ;
    } else {
  &out_line ( "local/global unknown line \"$namevar $val_tol\"\n" ) ;
    }
}
##########################################################################
sub check_speed {
#  ORIGIN4  a < 2 sec,  b < 10 sec, c < 1 min, d < 5 min, e < 30 min, f ...
#  HOMER:  a < 0.2 sec,  b < 1 sec, c < 5 sec, d < 30 sec, e < 5 min, f < 10 m

    # 05/17/13 Cab runs on gfortran exec for 50.0, 13.80 30.217 42.119
    # homer2 E5310 1.60GHz: 15:37min 0:38min  1:33min  4:44min
    # moe    X5650 2.67GHz:
    # jove FX-8350 4.00GHz:  4:04min 0:11min  0:17min  1:15min
    local ( $i, $n, $nn, $n1, $ctim, $ctim_real, $scale, $test_id, $mul );
    $n = $_[0];
    $ctim = $_[1];
    if ( $ctim <= 0.0 ) { $ctim = 0.000001 ; } # to avoid zero division
    $ctim_real = $ctim ; $scale = 1.0 ;
    if ( $hostname eq "jove" ) { $scale = 2.0 ; $ctim = $scale * $ctim ; }
    if ( $hostname eq "homer2" ) { $scale = 1.6 ; $ctim = $scale * $ctim ; }
    $test_id = "$_[2] $_[3]" ;
#    @tmax = ( 0, 2, 10, 60, 300 , 1800, 1e7 );
    @tmax = ( 0, 0.2, 1, 5, 30, 300, 600, 1e7 );
    
    $nn = ord ( $n ) - ord ( "a" );
    if ( $nn < 0 ) { $nn = 0; }
    if ( $nn > 6 ) { $nn = 6; }
    
    if ( $ctim < $timing_stats_min[$nn] ) { $timing_stats_min[$nn] = $ctim ; }
    if ( $ctim > $timing_stats_max[$nn] ) { $timing_stats_max[$nn] = $ctim ; }

    $i = 1;
    while ( $i < 8 ) {
  if ( $ctim < $tmax[$i] ) { $n1 = chr ($i-1+ord("a")) ; last ; }
  $i ++;
    }
    $new_speed = $n1;
    $timing_stats_total[$nn] ++;
    if ( $n1 gt $n ) { $timing_stats_above[$nn] ++; }
    if ( $n1 lt $n ) { $timing_stats_below[$nn] ++; }

    if ( $ctim > $tmax[$nn+1]*$margin || $ctim < $tmax[$nn]/$margin ) {
  if (  $ctim > $tmax[$nn+1] ) {
      $mul = $ctim/$tmax[$nn+1] ;
  } else {
      $mul = -$tmax[$nn]/$ctim;
  }
  &out_file(sprintf("###### Test $n: %5.2f sec, ".
        "<%5.2f..%5.2f> :: $include_file_name $_[2]\n".
        "  %5.2f ($n->$n1) $test_id\n\n",
        $ctim_real, $tmax[$nn]/$scale, $tmax[$nn+1]/$scale,
        $mul
      ) );
  if ( $ctim > $tmax[$nn+1] ) { $corr_up ++ }
  else                        { $corr_down++; }
    }

}
##########################################################################
sub is_safe_dir {
    local ($newdir, $pwd, $tmp);
    $newdir = $_[0] ;
    chomp ( $pwd = `pwd` ) ;
    if ( ! -d $newdir ) {
  return 1;
    }
    chdir $newdir or die "Cant cd to $newdir\n";
    if ( !-f ".run.id" ) { 
  chdir $pwd or die "Cant cd to $pwd\n";
  return 1;
    }
    open ( FF, "< .run.id" );
    $tmp = <FF> ;
    chomp $tmp;
    if ( $tmp ne "done" ) {
  chdir $pwd or die "Cant cd to $pwd\n";
  return 0;
    }
    chdir $pwd or die "Cant cd to $pwd\n";
    return 1;
}
##########################################################################
sub safe_run_dir {
    local ( $tmp, $dir );
    $tmp = &is_safe_dir ( "." );
    if ( $tmp ) { return; }
    for $count (0,9,8,7,6,5,4,3,2,1) {
  $dir = "../Scratch_" . $count ;
  $tmp = &is_safe_dir ( $dir );
  if ( $tmp ) {
      &run_in_dir ($dir);
      return;
  }
    }
    die "Cant find free work directory\n" ;
}
##########################################################################
sub local_dir {
    local ($newdir, $hh, $ttt, $tmp);
    chomp ( $pwd = `pwd` ) ;

    chdir or die "Cant cd to HOME ???\n" ;
    chdir "bin" or die "No ~/bin/ directory found\n";
    open (FF, "< localdisk") or die "No localdisk setup\n" ;
    $hh = `hostname`;
    chomp $hh;
    while ( <FF> ) {
  $tmp = $_;
  chomp $tmp;
  if ( $tmp =~ /$hh:/ ) {
      $tmp = <FF> ;
      $ttt = '---';
      if ( $tmp =~ /^\s*alias\s?loc\s?cd\s?(\S+)/ ) {
    $ttt = $1;
      }
      print "$ttt\n";
      if ( -d "$ttt/$ENV{LOGNAME}" ) {
    $ttt .= "/$ENV{LOGNAME}" ;
      }
      chdir $ttt or die "Cant cd to $ttt\n" ;
      if (! -d "qa-tests" ) {
    mkdir "./qa-tests",0777 or die "Cant make $ttt/qa-scripts\n";
      }
      $ttt .= "/qa-tests" ;
      
      print "Local run directory is $ttt\n";
      &run_in_dir ( $ttt );
      return;
  } 
    }
    die "Not set for local QA\n";
}
##########################################################################
sub run_in_dir {
    local ($newdir, $pwd, $pwd1);
    $newdir = $_[0] ;
    chomp ( $pwd = `pwd` ) ;
    if (! -d $newdir ) {
  mkdir $newdir,0777 or die "Cant create new folder $newdir \n" ;
    }
    chdir $newdir or die "Cant cd to new folder $newdir \n" ;
    system "rm -rf ./* ./.??*" ;
    if ( -d "./scripts" ) {
  if ( -f "./scripts/or_QA.constants" ) {
      $newdir = $newdir."/scripts";
      chdir "./scripts/" or die "Cant cd to new folder ./scripts \n" ;
      print "Moving to $newdir folder\n" ;
  } else {
      &rmtree ( "scripts" ) ;
      print "Recreating $newdir/script folder\n" ;
  }
    }
   
    if ( -d "../scripts" && -f "../scripts/or_QA.constants" ) {
  # print "Already have ../scripts directory \n" ;
    } else {
  print "\n->>>>Creating scripts workarea and all softlinks\n" if ( $paraqa >= 0 );
  mkdir "scripts",0777 or die "Cant create new folder scripts \n" ;

  chdir $pwd or die "Cant cd to $pwd\n";
  chdir ".." or die "Cant cd to ..\n";
  $pwd1 = $pwd ."/../" ;
  @tmp = `ls -d test* SCRIPTS`;
  chdir $pwd or die "Cant cd to $pwd\n";
  chdir $newdir or die "Cant cd to new folder $newdir \n" ;
  for $ttt (@tmp) {
      chomp $ttt ;
      system "ln -s $pwd1/$ttt $ttt" ;
  }
  $newdir = $newdir."/scripts";
    }
    chdir $pwd or die "Cant go back ??\n" ;
    system "cp -f or_QA.files* or_QA.constants *.inc $newdir/" ;
    if ( -f "or_QA.constants.local" ) {
  system "cp -f or_QA.constants.local $newdir/" ;
    }
    if ( $h3dtoxmlexec && -f $h3dtoxmlexec ) {
  system "cp -f $h3dtoxmlexec $newdir/" ;
    }
    if ( $exec_script ) {
  system "cp -f $exec_script $newdir/" ;
    }
    chdir $newdir or die "Cant cd to new folder $newdir (2)\n" ;
    print "**** Shifting runs to $newdir \n" if ( $paraqa >= 0 );
    
}
##########################################################################
sub write_include_stats {
    $file = $_[0] ;
    ($usercpu, $systemcpu, $cusercpu, $csystemcpu) = times;
    $ctim_fmt = &format_time ($csystemcpu + $cusercpu ); 
    
    $ctim = ( time - $timestart );
    $ctimw_fmt = &format_time ( $ctim );

    if ( ($csystemcpu + $cusercpu ) ) {
  $cpu = "CPU: $ctim_fmt/$ctimw_fmt" ;
    } else {  
  $cpu = "Clock: $ctimw_fmt" ;
    }
    $tmp1 = substr($file,9,20);
    if ( substr($tmp1,0,4) eq "test" ) {
  $tmp1 = substr($file,13,20);
    }
    if ( substr($tmp1,0,1) eq "_" ) {
  $tmp1 = substr($tmp1,1,20);
    }
    $tmp1 = substr($tmp1." ---------------------",0,15);
    $tmp2 = sprintf("(%3d)",$num_runs_attempted - $files_at_start) ;
    if ( $num_runs_failed ) {
  $temp = sprintf("fail:%2d/%3d", $num_runs_failed, $num_runs_attempted);
    } else {
  $temp = sprintf("tests:  %4d     ", $num_runs_attempted);
    }
    if ( ! $run_list && ($num_runs_attempted - $files_at_start) ) {
  $tmp = sprintf("(%2d.0) %15s%s %s %s\n", $include_file_id, $tmp1, $tmp2, $temp, $cpu) ;
  &out_file ( $tmp ) ;
    }
    $files_at_start = $num_runs_attempted;
    $wall_at_start = $ctim;
    $cpu_at_start = $csystemcpu + $cusercpu;
    
}
##########################################################################
sub format_time_1 {
    if ( $_[0] && $_[0] < 50.0 ) {
  return sprintf("%4.1fsec", $_[0] ); 
    } else {
  return format_time($_[0]);
    }
}
##########################################################################
sub format_time {
    # return string representing time in human form, input time in seconds;
    local ($tim, $tim_min, $tim_fmt, $tim_hr);
    $tim = $_[0]/60.0;
    $tim_min = int($tim) ;
    if ( $tim_min < 60 ) {
  $tim_fmt = sprintf("%2d:%02dmin", $tim_min, int(($tim-$tim_min)* 60.0) );
    } else {
  $tim_hr = int($tim/60);
  $tim_min = $tim_min - $tim_hr*60 ;
  $tim_fmt = sprintf("%d:%02d:%02dh", $tim_hr, $tim_min, int(($tim-$tim_min-$tim_hr*60)* 60.0) );
    }
    return $tim_fmt;
  
}
##########################################################################
sub fmt_time_db {
    my $timestotal=int($_[0]);
    my $timehours=$timestotal/3600;
    $timestotal=$timestotal%3600;
    my $timemins=$timestotal/60;
    my $timessecs=$timestotal%60;
    my $runcputime = sprintf("%02d:%02d:%02d",$timehours , $timemins,$timessecs);
    return $runcputime;
}

##########################################################################
sub rmtree {
    $dir = $_[0];
    unlink <$dir/*> ;
    rmdir $dir ;
}
##########################################################################
sub cleanup {
    # also in a separate file, this one is more thorough

    print "Cleaning temporary files ....\n" ;

    @qa_dirs = ( "Screen_Output", "Extracted_data", "Results_data",
     "Other_Output", "$out_files_dir" );

    foreach $i (@qa_dirs) {
  rmtree ( $i ) ;
    }
    
    unlink  </tmp/run*scr*>, <ftn[0-9]*>, <fort.[0-9]*> ;
    unlink  <*.out.o>, <*_scr.*>, 
    
    unlink ( "QA.summary", <QA.code*>, <.run.id>, "ptest.dat" ,
       "brief.info", "tracker".$tracker_failures_suffix.".info" );

    # PHLEX specific
    # delete [.](phx|sav|ntl|stats)$
    # delete ^(phlex.*|#phlex.*|save.*|phlex.*out|Unknown|Time.*|ds_.*scr)$
    
    $old_script_dirs    = "../script[0-9]* scripts.tar ../Scratch*" ;
    system ( "rm -rf $old_script_dirs" ) ;

    if ( $#save_ext + $#delete_ext >= -1 ) {
  @ls = qx/ls/ ;
  NEXTFILE: foreach $file ( @ls ) {
      chomp $file;
      next if ( -d $file );
      next if ( -l $file );
      next if ( ! -w $file ); # try to protect perforce protected files
      foreach $pat ( @save_ext ) {
    if ( $pat ) {
        if ( $file =~ /$pat/ ) {
      unlink ($file) ;
      next NEXTFILE;
        }
    }
      }
      foreach $pat ( @delete_ext ) {
    if ( $pat ) {
        if ( $file =~ /$pat/ ) {
      unlink ($file) ;
      next NEXTFILE;
        }
    }
      }
  }
    }
      
}
##########################################################################
sub cleanall {
    
    $screen_output_dir  = "Screen_Output" ;
    $extracted_data_dir = "Extracted_data" ;
    $results_data_dir   = "Results_data" ;
    $other_output_dir   = "Other_Output" ;
    $qa_summary         = "QA.summary" ;
    $local_executable   = "QA.code*" ;  # can be .exe on Windoze

    &cleanup ;
    
    &rmtree (  $screen_output_dir ) ;
    &rmtree (  $extracted_data_dir ) ;
    &rmtree (  $other_output_dir ) ;
    &rmtree (  $saved_files_dir ) ;   
    &rmtree (  $results_data_dir ) ;
    
    &rmtree (  $out_files_dir ) ;

    unlink "brief.info" ;

    unlink <*~> ;

    system ("rm -rf build-[0-9][0-9]*"); # build subdirs
    system ("rm -rf ../Scratch_*");       # parallel run dirs

    open ( RUNID, "> $run_id_file" );
    print  RUNID "done\n" ;
    close  RUNID ;

}
##########################################################################
sub opendinfo {
      open ( DINFO, "> detail.info" );
  print DINFO "\$dummyfile=1;\n";
  if($nightlyqa != 0){
          if($nightlyqa !=0){print DINFO "\$run\{runcputime\}=q(00:00:01);\n";}
          if($nightlyqa !=0){print DINFO "\$run\{runwalltime\}=q(00:00:01);\n";}
          if($nightlyqa !=0){print DINFO "\$dummyfile=0;\n";}
    if($nightlyqa !=0){print DINFO "\$run\{rptchge\}=q(${nightlyqa});\n";}
    if($nightlyqa !=0){print DINFO "\$run\{rptbranch\}=q(${rptbranch});\n";}
  }
}
sub closedinfo {
        if($nightlyqa == 0) {
            return;
        }
        close(DINFO);
  if($nightlyqa != 0){
                if ( $ENV{HOME} ) {
      system ("cp detail.info \"$ENV{HOME}\"");
                }
  }
        $nightlyqa = 0;
}
##########################################################################
sub counttime {
    #print "countime args: $_[0]-$_[1]-$_[2] $_[3]:$_[4]:$_[5]\n";
  @mondays=(0,31,28,31,30,31,30,31,31,30,31,30,31);
    
    $numofdays=0;
    for($i=1970;$i<$_[0];$i++){
      $numofdays+=&diy($i);
    }

    for($i=1;$i<$_[1];$i++){
      $numofdays+=$mondays[$i];
    }

    $numofdays+= ($_[2] - 1);
    $numofhour=$numofdays*24 +$_[3];
    $numofmin=$numofhour*60 + $_[4];
    #$numofsec=$numofmin*60 +$_[5];

    #print "countime rst: $numofdays:$numofhour:$numofmin:$numofsec\n";
    $numofmin;

}
##########################################################################
sub diy($)
{
    my $y = shift;
    $y % 4 && return 365;
    $y % 100 || $y % 400 && return 365;        
    return 366;
}
##########################################################################
sub check_ascii {
    # verify all run.* files for proper ASCII type
    my $ret = 0;
    my $id = "-";
    opendir DIR,"." ;
    if ( $in_include > 0 ) {
  $id = sprintf("%3d.%-3d",$include_file_id,$test_id) ;
    } else {
  $id = sprintf("%3d",$test_id) ;
    }
    my @files=readdir(DIR);
    foreach $i (@files) {
  if ( -d $i ) { next; }
  if ( $i eq $Run_file ) { next; }
  if ( ! ( $i =~ /^run./ ) ) { next; }
  if ( $i =~ /^run.*_fsmth.fem$/ )  { next; } # smoothing run files.
  if ( $i =~ /^run_mbd/ )  { next; } # smoothing run files.
  $filelist{$i} = $id;
  #  if ( $i eq "run.hgdata" ) { next; }
  if ( $i =~ /^run.*oss$/ )  { next; } # because of ATAG
  if ( $i =~ /^run.*h3d\d*$/ )  { next; } #h3d10...
  if ( $i =~ /^run.*res$/ )  { next; }
  if ( $i =~ /^run.*eigv$/ ) { next; }
  if ( $i =~ /^run.*dmg$/ )  { next; }
  if ( $i =~ /^run.*rst$/ )  { next; }
  if ( $i =~ /^run.*fbi$/ )  { next; }
  if ( $i =~ /^run.*out2$/i )  { next; } #OUT2 are binaries
  if ( $i =~ /^run_.*pch$/ ) { next; } # DMIG files have LF only
    if ( $i =~ /^runT\d+$/ )  { next; } # RADIOSS T file
    if ( $i =~ /^runA\d+$/ )  { next; } # RADIOSS A file
  if ( $i =~ /^run.*scr$/ || $i =~ /^run.*_scr/ ) {
      $scratch_count ++;
      next; } 
  if ( $i =~ /^run_rad/ ) { next; }
  if ( $i eq "run.op2" )     { next; }
  if ( $i eq "run.mnf" )     { next; }
  if ( $i =~ /^run.*_fsmth.fem$/ )  { next; } # scrambled fem files
  $ftype = `file $i` ;
  chomp $ftype ;
  if ( $ftype =~ /empty$/ || $ftype =~ /Bio-Rad.*Image File/ ) {
      next ; }
  if ( $platform eq "NT" ) {
      
      if ( $ftype =~ /with.CRLF.line.terminators/) {
    next ;
      }
      &out_file ("$full_test_id file_unix_type $ftype\n") ;
      $filelist_bad{$i} = $id;
      $ret = 1;
  } else {
      if ( $ftype =~ /.*ASCII.*text/ || $ftype =~ /UTF-8.*text/ ) {
    if ( $ftype =~ /.*line.terminators/ ) {
        &out_file ("$full_test_id file_line_type $ftype\n") ;
        $ret = 1;
        $filelist_bad{$i} = $id;
    }
      } else {
    &out_file ("$full_test_id file_check_left $ftype\n") ;
    $ret = 1;
    $filelist_bad{$i} = $id;
      }
  }
    }
    closedir DIR;
    return $ret;
}
##########################################################################
sub check_new_files {

    my @filelist;
    my $k = 0;
    ($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,$size,
     $atime,$mstarttime,$ctime,$blksize,$blocks)
  = stat("$_[0]");
#    print "$_[0]=".join(',',($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,$size,
#     $atime,$mstarttime,$ctime,$blksize,$blocks))."\n";

    opendir DIR,"." ;
    my @files=readdir(DIR);
    foreach $i (@files) {
  if ( -l $i ) { next; }
  if ( substr($i,0,2) eq "QA" || substr($i,0,3) eq "run" ) { next; }
  if ( -d $i ) { next; }
  ($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,$size,
   $atime,$mtime,$ctime,$blksize,$blocks)
      = stat($i);
  if ( $mtime <= $mstarttime ) { next; }

  # other expected names are set 
  if ( $i eq $exe_name_file || $i eq $failure_file ) {
      next; }

  $valid = 0;
  foreach $j (@expectfile) {
      if ( $i =~ m,$j, ) { $valid = 1; last; }
  }
  if ( $valid ) { next ; }

  $filext = $i ;
  $filext =~ s/^.*\.// ;
  
  foreach $j (@expectfileext) {
      if ( $filext =~ m,$j, ) { $valid = 1; last; }
  }
  if ( $valid ) { next ; }
  
  # $dif = $mtime - $mstarttime;
  # print "$i $mtime $mstarttime $dif\n";
  $k = push ( @filelist, $i);
    }
    if ( $k ) {
        if ($_[1]){
          #testing each example  
          print "New files on $_[1]: \n";
          $leftovers{$_[1]}=join(' ',@filelist);
    $k = 0;
    foreach $i (@filelist) {
        print " $i";
        # system ("ls -l $i");
        $k++;
        if ( $k >4 ) {
      $k = 0; print("\n");
        }
    }
    print "\n";
              if ($keep_results == 1) {
                my $cmd=0;
                print "\nKeep files to directory : $keep_results_dir\n";
                my $keep_dir=$keep_results_dir;
                my $subdir="";
                my $create_ref_dir="";
                if ($sensitivity == 1) {
                  my $seed=$sensitivity_cur_n/$sensitivity_n;
                  $subdir.="/$sensitivity_n"."_"."$sensitivity_xalea"."/$sensitivity_cur_n"."_".$seed;}
                $keep_dir="$keep_results_dir/$qa_fem_files_file/$full_test_id$subdir";
                if ($selfref_pass > 0) {$keep_dir="$keep_dir/pass_$selfref_pass";}
                if ($create_ref > 0) { $create_ref_dir="$input_path/reference" } 
                if (-d $keep_dir) {$cmd=0;}
                else {$cmd=system("mkdir -p $keep_dir")};
                print "Create keep dir cmd=mkdir -p $keep_dir\n";
                print "Create keep dir status=$cmd\n";
                if ($create_ref) {
                  if (-d $create_ref_dir) {
                    $cmd=0;
                    print "Cleaning files under $create_ref_dir ...\n";
                    # system("p4 revert $create_ref_dir/...");
                    opendir(CDIR, $create_ref_dir) or die $!;
                    while (my $cdirfile = readdir(CDIR)) {
                        $cdirfile =~ /A[0-9][0-9][0-9](\.gz)?$/ and do {
                          system("git rm -f $create_ref_dir/$cdirfile");
                        };
                    }
                  }
                  else {$cmd=system("mkdir -p $create_ref_dir")};
                  print "Create reference dir status=$cmd\n";
                  print "Create reference dir status=mkdir -p $create_ref_dir\n";
                }  
                print "            test subdir : $keep_dir\n";
                if ($create_ref > 0) { 
                print "    reference directory : $create_ref_dir\n"; }
                my $first_anim=""; 
                my $last_anim=""; 
                my $dirs_flag=1;
                if (not -d $keep_dir) {$dirs_flag=0}
                if (not -d $create_ref_dir and $create_ref > 0) {$dirs_flag=0}
                if ($dirs_flag) {
                  for (@filelist){
                    my $file=$_;
                    my $i_copy=1;
                    my $last_anim="";
                    my $first_anim="";
                    my $last_anim_gz="";
                    my $first_anim_gz="";
                    if ($create_ref > 0)  { 
                      $i_copy=0; 
                      my @anims=grep {/A[0-9][0-9][0-9]$/} @filelist;
                      my @animsgz=grep {/A[0-9][0-9][0-9].gz$/} @filelist;
                      push @anims,@animsgz;
                      my @anims_sorted=sort @anims;
                      my @anims_sortedgz=sort @animsgz;
                      $first_anim=$anims_sorted[0]; 
                      $last_anim=$anims_sorted[-1]; 
                      $first_anim_gz=$anims_sortedgz[0]; 
                      $last_anim_gz=$anims_sortedgz[-1]; 
                    }
                    if ($create_ref > 0) { 
                      if ($file =~ /.out$/ and $create_ref > 0) { $i_copy=1 } 
                      if ($file =~ /.abf$/ and $create_ref > 1) { $i_copy=1 } 
                      if ($file =~ /.thy$/ and $create_ref > 1) { $i_copy=1 } 
                      if ($file =~ /.T[0-9][0-9]$/ 
                                           and $create_ref > 1) { $i_copy=1 } 
                      if ($last_anim) { 
                        if (($file eq $last_anim)
                            and $create_ref > 2) { $i_copy=1 } 
                      }
                      if ($last_anim_gz) { 
                        if (($file eq $last_anim_gz)
                            and $create_ref > 2) { $i_copy=1 } 
                      }
                      if ($first_anim) { 
                        if (($file eq $first_anim)
                            and $create_ref > 2) { $i_copy=1 } 
                      }
                      if ($first_anim_gz) { 
                        if (($file eq $first_anim_gz)
                            and $create_ref > 2) { $i_copy=1 } 
                      }
                      if ($file =~ /A[0-9][0-9][0-9]$/ 
                                           and $create_ref > 4) { $i_copy=1 } 
                      if ($file =~ /A[0-9][0-9][0-9].gz$/ 
                                           and $create_ref > 4) { $i_copy=1 } 
                      if ($file =~ /A[0-9][0-9][0-9]$/) {
                        qx(gzip -f $file); $file=$file.".gz"; 
                      } 

                      # XXXXXX take h3d files into account when creating reference files
                      if ($file =~ /.h3d$/ and $create_ref > 3) { $i_copy=1 }
                      # END XXXXXX

                    }
                    if ($i_copy and $create_ref_dir) {
                      my $tmpcmd="cp -fp $file $create_ref_dir";
                      system($tmpcmd) and printf $tmpcmd."\n";;
                      system("git add $create_ref_dir/$file");
                    }
                    my $tmpcmd="cp -fp $file $keep_dir";
                    system($tmpcmd) and printf $tmpcmd."\n";;
                  }         
                }
                else {
                  printf "Cannot create keep results directory : $keep_dir\n";
                  printf "Cannot copy new files to keep results directory.\n";
                }
              }

      print "\n";
        }else{
          #at the end
          print "Check for new files: \n";
          if($check_newfile){
              foreach(keys %leftovers){
                  print "$_ $leftovers{$_}\n";
              }
          }else{
        $k = 0;
        foreach $i (@filelist) {
      if ( $i eq "$qadiaginc.bk" || $i eq $qadiaginc ||
          $i eq "p4_files" ) {
          next;
      }
            print " $i";
            # system ("ls -l $i");
            $k++;
            if ( $k >4 ) {
          $k = 0; print("\n");
            }
        }
              if ($sandbox){
                my $cmd=0;
                print "\nMove new files to sandbox directory : $sandbox\n";
                if (-d $sandbox) {$cmd=1;}
                else {$cmd=mkdir($sandbox)};
                if ($cmd) {
                  for (@filelist){
                    system("mv -f $_ $sandbox") and printf "mv $_ $sandbox failed !\n";;
                  }
                }
                else {
                  printf "Cannot create sandbox directory : $sandbox\n";
                  printf "Cannot move new files to sandbox.\n";
                }
              }
              
        print "\n";
          }

        }
    }
}
##########################################################################
sub skip {
    # skip to the next line with else/endif
    # if arg == 1 then only skip to endif, else is an error
    
    my $skip_to_endif = $_[0];
    my $has_else = 0;

    # print "Entering SKIP $skip_to_endif\n" ;
    
    if ( ! $within_else && $skip_to_endif ) {
  die ( "$cur_file_name: \"else\" not inside if/then/else\n" );
    }
    $within_else = 1;

    while (<$infile>) {
  # print "In SKIP: $_" ;
  chomp ;
  
  if (/^\s*endif\s*$/i) {
      $within_else = 0;
      return " ";
      
  } elsif (/^\s*(go|newid|then)\W/i) {
      die ( "$cur_file_name: \"$1\" inside if/then/else\n" );
      
  } elsif (/^\s*else\s*(if.*then)$/i) {
      if ( ! $skip_to_endif ) {
    return $1 ; }

  } elsif (/^\s*else\s*$/i) {
      die ( "$cur_file_name: \"else\" after else\n" ) if ( $has_else ) ;
      $has_else = 1;
      if ( ! $skip_to_endif ) { return " " ; }

  }
    }
    die ( "Missing endif in file\n" );

}
##########################################################################
# Keywords evaluation routines
##########################################################################
sub store_keywords {
    # accept argument to --keywords and store into the list
    my @x = split(/,/,$_[0]);
    foreach $i (@x) {
  my $k = substr($i,0,1) ;
  my $kk = substr($i,1);
  if ( $k eq "+" ) {
      push (@global_keywords,$kk );
  } elsif ( $k eq "-" ) {
      push (@global_keywords, $kk );
      push (@global_keywords, "not" );
  } else {
      push (@global_keywords ,$i );
  }
    }
    print " --keywords=" .join(':',@global_keywords) . "\n" ;
}

##########################################################################
sub eval_keywords {
    # uses global arrays: @global_keywords and @local_keywords
    # return 1 if true, 0 if false
    @eval_stack = ();
    my ( $i, $j, $k, $sor, $snot, $sop );
    ## my ( $kk, $op );
    $sor = 0;$snot = 0;$sop = 0 ;
    ## print "Eval " . join (':',@local_keywords) . "\n" ;
#         print 'local='.join(@local_keywords,':')."\n";
#         print 'global='.join(@global_keywords,':')."\n";
    MLOOP: foreach $i (@global_keywords) {
  ## print "$op : " . join (':',@eval_stack) . "\n" if ( @eval_stack );
  ## $kk = sprintf("%10s : ",$i);
  ## print $kk ;
  ## $op = '*';
  if ( $i eq "not" ) {
      $j = &pop_stack;
      $snot ||= $j ;
      push ( @eval_stack, ! $j);
  }
  elsif ( $i eq "or" ) {
      $j = &pop_stack ;
      $k = &pop_stack ;
      push ( @eval_stack, ($j or $k) );
      $sop = 1;
  }
  elsif ( $i eq "and" ) {
      $j = &pop_stack ;
      $k = &pop_stack ;
      push ( @eval_stack, ($j and $k) );
      $sop = 1;
  }
  elsif ( $i eq "xor" ) {
      $j = &pop_stack ;
      $k = &pop_stack ;
      push ( @eval_stack, ($j xor $k) );
      $sop = 1;
  }
  else {  # try for match with @local_keywords
      ## $op = ' ';
      foreach $j (@local_keywords) {
    if ( $j =~ /^${i}$/ ) {
        push ( @eval_stack, 1 );
        $sor = 1;
        next MLOOP;
    }
      }
      push ( @eval_stack, 0 );
  }
    }
    ## print "$op : " . join (':',@eval_stack) . " ($#eval_stack) \n" ;
    if ( $#eval_stack > 0 ) {
  die "Bad keywords expression, stack full" if ( $sop ) ;
  $j = $sor && ( ! $snot );
    }
    else {
  $j = &pop_stack ;
    }
    ## print "Eval result : $j \n" ;
    return $j;
}
##########################################################################
sub pop_stack {
    die "Bad keyword expression, stack empty" if ( ! @eval_stack ) ;
    return pop (@eval_stack ) ;
}
##########################################################################
sub track_diff {
    #returns examples from $1 which do not exist in $2
    $new_id = $_[0];
    $old_id = $_[1]; # old_id < new_id;
    
    $e_list = "" ;
  
    %nn = ();
    $a = $track_fails[$new_id] ;
    if ( $a eq "" ) { return; }
    foreach $e (split  /,/, $a ) {
  $nn{$e} = "";
    }
    $a = $track_fails[$old_id] ;
    foreach $e (split  /,/, $a ) {
  $nn{$e} = $e;
    }
    $a = $track_fails[$new_id] ;
    foreach $e (split  /,/, $a ) {
  if ( $nn{$e} eq "" ) {
      $e_list .= "$e," ;
  }
    }

}
##########################################################################
sub init_tracking {

    # XXXXXX Avoid all NFS/SAMBA usage - replace by an unique rsync step
    # If the --real_exe_dir option is used, that means that we need to copy remote binaries locally
    # in the way to use tracking with local binaries
    if (defined $real_exe_dir) {
      my $workspace = $ENV{'WORKSPACE'};

      if ($ENV{'ARCH'} eq 'win64') {
        # Transform windows path format to cygwin (linux style)
        $workspace =~ /^([A-Z]):/ and do {
            my $newpath = '/cygdrive/'.lc($1);
            $workspace =~ s/^([A-Z]):/$newpath/;
            $workspace =~ s/\\/\//g;
        };
      }
      
      # Call adapter
      my $cmd_adapter = "perl $workspace/qa_rsync_adapter.pl --changelist=$changelists[$changelist_current] --execdir=$exec_tracker_path_orig --engine=$exec_tracker --branch=$ENV{'BRANCH'} --arch=$ENV{'ARCH'} --real_exe_dir=$real_exe_dir";
      &out_file("Getting binaries locally, calling : $cmd_adapter\n");    
      if (system($cmd_adapter)) { die "ERROR Running cmd $cmd_adapter, maybe WORKSPACE variable is not defined, this path must include the adapter script"; };
      $executable = $exec_tracker_path_orig . "/" .$changelists[$changelist_current] . "/" . $exec_tracker ;   

    }
    else {
      $executable = $exec_tracker_path . "/" .$changelists[$changelist_current] . "/" . $exec_tracker ;
    }
    $exec_in_place = 1;
    $local_executable = "" ; # otherwise it may get erased
    &out_file("Switching to older executable: $executable \n") ;

        my @selfreference_args=map {chomp($_);$_ } split(',',$selfreference);
        if (  grep { $_ =~ /^(-ref_exe=[^,])/ }  @selfreference_args
              and grep { $_ eq "-track_ref_exe"} @selfreference_args ) {
          my $refexe=substr((grep { $_ =~ /^(-ref_exe=[^,])/ }  @selfreference_args)[-1],9);
          if ($changelist_minimum) {
            if ( $refexe =~ m=(.*)/([^/]*)/([^/]*)$= ) {
        my $refexec_tracker_path = $1;
        my $refexec_tracker = $3 ;
        my $refchangelist_current = $2;
              $refexe = $refexec_tracker_path . "/" .
        $changelists[$changelist_current] . "/" . $refexec_tracker ;
              @selfreference_args=grep { not $_ =~ /^(-ref_exe=[^,])/ } @selfreference_args;
              push @selfreference_args,"-ref_exe=".$refexe;
              $selfreference=join(',',@selfreference_args);
              &out_file("Switching to older ref executable: $refexe \n") ;
            }
          }
        }
    &out_file("Failures: $required_example\n") ;
    $verbose = 1;
    $run_mark = "";
    $running_double_check = 0;
    $running_tracker = 1;
    $aborted_run = 0;
    $sanity_stop = 0;
    &closedinfo;
}


##########################################################################
##########################################################################
sub read_tracker_failures {
  my $val=$tracker_failures_suffix;
  if ($tracker_failures_suffix_ref) {
     $val=$tracker_failures_suffix_ref }
  my $failures_counter=0;
  my $failures_list='';
  if ( -f  "tracker.failures_$val" and $changelist_minimum) {
    print "TRACKER FAILURES TRACES : reads tracker.failures_$val\n";
    &my_reader("tracker.failures_$val");
    print "Loading : tracker.failures_$val ...\n=> $runargs_compute\n";
    for $key (keys %failures) {
      $failures{$key}{'Old_issue'}=1;
      if ($failures{$key}{'Status_flag'} <= 0) {
        $failures_counter++;
        $failures_list.="$key ";
      }
    }
    print "   => $failures_counter pending failure(s)\n";
    print "   => $failures_list\n";
  }
  elsif ($changelist_minimum) {
    print "No file : tracker.failures_$val found\n=> $runargs_compute\n";
    exit 1;
  }
}



sub update_tracker_failures {
  my $val=$tracker_failures_suffix;
  if ($tracker_failures_suffix_ref) {
     $val=$tracker_failures_suffix_ref."_new" }
  my $failures_counter=0;
  my $failures_list='';
  my $failures_fixed_list='';
# fill changes
  my %changes=();my $change;
  my @tmpout=qx(p4 changes);
  for $change (@tmpout) {
    my $id=(split(' ',$change))[1];
    my $dev_field=(split(' ',$change))[5];
    my $dev=(split('@',$dev_field))[0];
    my $title=substr($change,index($change,"'"));
    $title =~ s/^'//;
    $title =~ s/'$//;
    $title=substr($title,0,length($title)-1);
    $changes{$id}{'dev'}=$dev;
    $changes{$id}{'title'}=$title;
  }

## Update failures with dev and title
  for (keys %failures) {
    my $failure_key=$_;
    if ($failures{$failure_key}{'Changelist'}+0 < 0) {
      $failures{$failure_key}{'Dev'}='qamail';
      $failures{$failure_key}{'ChangelistTitle'}='Last cl tested => issue not found';
    }
    elsif (exists $changes{$failures{$failure_key}{'Changelist'}}) {
      my $id=$failures{$failure_key}{'Changelist'};
      my $dev1=$changes{$id}{'dev'} || "";
      $failures{$failure_key}{'Dev'}=$dev1;
      my $title1=$changes{$id}{'title'} || "";
      $failures{$failure_key}{'ChangelistTitle'}=$title1;
    }
    else {
      $failures{$failure_key}{'Dev'}='Unknown dev';
      $failures{$failure_key}{'ChangelistTitle'}='Unknown cl';
    }
  }
##
  use Time::HiRes qw/gettimeofday/;
  $out_buffer .= "Writing : tracker.failures_$val ... => \$runargs_compute at ".gettimeofday()."\n";
  $failures_infos{'date'}=strftime("%d %B %Y  %H:%M", localtime(time));
## keep and timestamp 10 last tracker.failures files
  my $timestamp=strftime("%B_%d__%Hh%M", localtime(time));
  my $suffix_cl="_".$cl_executable."_";

  if (-f "tracker.failures_".$val ) { 
    print "TRACKER FAILURES TRACES : moving tracker.failures_$val into tracker.failures_$val$suffix_cl$timestamp at ".gettimeofday()."\n";
    qx(mv tracker.failures_$val tracker.failures_$val$suffix_cl$timestamp) 
  }

  # Removing old timestamped backup tracker files, keep last 20
  my @tabtmp=qx(ls -1t tracker.failures_${val}_* 2>/dev/null);
  chomp @tabtmp;
  my @tabtmp2;
  my $i=1;
  # Browsing result and keeping only timestamp backup files
  for my $file (@tabtmp) {
      # Keeping last 20 ones (checking also french accent)
      if ($file =~ /tracker\.failures_${val}_[0-9]+_([A-Za-zéû])+_[0-9][0-9]__[0-9][0-9]h[0-9][0-9]/) {
          if ($i > 20) {
              push (@tabtmp2,$file);
          }
          $i++;
      }
  }
  for my $remove_file (@tabtmp2) { 
    print "TRACKER FAILURES TRACES : removing old backup tracker file $remove_file at ".gettimeofday()."\n";
    unlink $remove_file; 
  }

  print "TRACKER FAILURES TRACES : my_hash_writer_sorted at ".gettimeofday()."\n";
  &my_hash_writer_sorted(">tracker.failures_$val","failures_infos",%failures_infos);
# clean old fixed issues
  for (keys %failures) {
    my $failure_key=$_;
    my $dt=time;
    if ($failures{$failure_key}{'Status_flag'} > 0) {
      $dt=$dt-$failures{$failure_key}{'Status_flag'};
      $dt=$dt/(3600*24);
      if ($dt > $max_fixed_days) {
        delete $failures{$failure_key};
        $failures_fixed_list.="$failure_key ";
      }
    }
    elsif ($failures{$failure_key}{'Status_flag'} <= 0) {
      $failures_counter++;
      $failures_list.="$failure_key ";
    }
  }
  print "TRACKER FAILURES TRACES : my_hashofhash_writer_sorted at ".gettimeofday()."\n";
  &my_hashofhash_writer_sorted(">>tracker.failures_$val","failures",%failures,);
  $out_buffer .= "   => Old fixed failure(s) removed : $failures_fixed_list\n";
  $out_buffer .= "   => $failures_counter pending failure(s)\n";
  $out_buffer .= "   => $failures_list\n";
  &out_file( "$out_buffer" );
  print "TRACKER FAILURES TRACES : end of action on tracker.failure, checking presence at ".gettimeofday()."\n";
  system("ls -l tracker.failures_$val");
}

sub get_describe () {
  my ($mycl)=@_;
  my $description="Unknown cl";
  if ($mycl <= 0) {return $description}
  my @tmpout=qx(p4 describe -s $mycl);
  my $i_pri=0;
  $description="";
  for my $line (@tmpout) {
    if ($line =~/^[\S]/) {$i_pri=0;}
    if ($i_pri == 1)    {$description.=$line}   
    if ($line =~/^Change $mycl/) {$i_pri=1;}
  }
  return $description;
}

sub tracker_report {
    # empty file when tracking is not active
    
    open ( TRACKREP, "> tracker".$tracker_failures_suffix.".info" );
    if ( ! $changelist_minimum ) { return; }

    print TRACKREP "execname: $exname\n";
    print TRACKREP "host:     $hostname\n";
    print TRACKREP "options:  $runargs\n";
    print TRACKREP "workarea:\@$changelists[$#changelists]\n";

    if ( $i_tracker_shortcut == 1) { 
  $out_buffer .= "\n !! Tracker shortcutted : failures > $tracker_shortcut_max_failures\n";
  $out_buffer .= "\n !!                and changelists > $tracker_shortcut_max_cls\n";
  print TRACKREP "\n !! Tracker shortcutted : failures > $tracker_shortcut_max_failures\n";
  print TRACKREP "\n !!                and changelists > $tracker_shortcut_max_cls\n";
    }
    $out_buffer .= "=" x 60 ;
    $out_buffer .= "\n == Results of failure tracking: == \n";
    if ( $track_eliminated ) {
  $out_buffer .= "\n Following failures were identical at first and last".
      " changelist\n and were eliminated from tracking to save time:".
      "\n $track_eliminated\n" ;
    }
    $i = $#changelists;
    while ( $i >= 0 ) {
  $out_buffer .= " \n" ;
  $out_buffer .= " Exec: $changelists[$i] \n" ;
  $a = $track_fails[$i] ;
  @aa = split(/,/,$a) ;
  $kntf = $#aa +1;
  $out_buffer .= " $kntf failure(s):\n $a\n" ;
  print TRACKREP " Exec\@$changelists[$i]: $a \n" ;
  if ( $i_tracker_shortcut == 1 and $i > 0) { $i=0; }
  else { $i -- }
  if ( $a eq "" ) { last; }
    }
    
    $out_buffer .= "-" x 60 ;
    $i = $#changelists;
    while ( $i > 0 ) {
  my $i_cur=$i;
  my $i_next=$i-1;
  if ( $track_fails[$i] eq "" ) { last; }
  if ( $i_tracker_shortcut == 1 and $i > 0) { 
    $i_next=0;
  }
  &track_diff ( $i_cur, $i_next );
  $e_list =~ s/,/ /g ;
  
# Status flag :
# 
  if ( $e_list ) {
        my @fail_list=split(/,/,$track_fails[$i]);
        for (@fail_list) {
          my $failure_key=$_;
      &init_failure($failure_key,'old');
      # $a = `p4 describe -s $changelists[$i]` ;
        $a = "  $exname: qa workarea at $hostname synced to "
      . "\@$changelists[$#changelists] $run_options_line";
        $out_buffer .= "\n" . "=" x 60 .
    "\n Exec built with changelist $changelists[$i_cur] \n $a\n  "
    . "showed following new failures compared to exec from "
    . "changelist $changelists[$i_next]:\n$e_list\n";
      print TRACKREP "New failures \@$changelists[$i_cur] against"
    . " \@$changelists[$i_next]: $e_list\n" ;
        }
# Update solved issues with corresponding changelist
        &track_diff ( $i-1, $i );
        my @solved_list=split(/,/,$e_list);
        for (@solved_list) {
          my $failure_key=$_;
          $failures{$failure_key}{'Changelist_fixed'}=$changelists[$i];
          $failures{$failure_key}{'Status_flag'}=$time;
          $failures{$failure_key}{'Status_flag_date'}=strftime("%d %B %Y  %H:%M", localtime($failures{$failure_key}{'Status_flag'}));
          $failures{$failure_key}{'Old_issue'}=0;
          $failures{$failure_key}{'Extract_fixed'}=join('',@{$tests_infos{$failure_key}{'Extract'}});
        }        
  }
  
  $i -- ;

    }
    if ( $track_fails[0] ) {
      my $tmp_info=0;
  $out_buffer .= "\n" . "=" x 60 . "\n";
  $out_buffer .= "\n Old failures:\n$track_fails[0]" .
      "\n present in changelist $changelists[0]\n";
  print TRACKREP "Old failures \@$changelists[0]: $track_fails[0]\n" ;
    my @fail_list=split(/,/,$track_fails[0]);
    for (@fail_list) {
      my $failure_key=$_;
      &init_failure($failure_key,'last');
      $failures{$failure_key}{'Status_flag'}=-2;
      $failures{$failure_key}{'Changelist'}=-$changelists[0];}
    }
    my @timeout_list=split(' ',$list_timeout);
    for (@timeout_list) {
      my $failure_key=$_;
      if (not exists $failures{$failure_key}) {
      &init_failure($failure_key,'last');}
      $failures{$failure_key}{'Status_flag'}=-3;
      $failures{$failure_key}{'Changelist'}=-$changelists[0];}
    if ( $track_eliminated ) {
  $out_buffer .= "\n Old failures eliminated from tracking ".
      "(identical \@$changelists[0] and \@$changelists[$#changelists]):".
      "\n $track_eliminated\n" ;
    }
    if ( $track_changes_txt ne "" ) {
  $out_buffer .= "\n" . "!" x 60 .
      "\n Detected change(s) in failure pattern:\n".
      "$track_changes_txt" ;
    }
    $out_buffer .= "\n" . "=" x 60 . "\n";

    $failures_infos{'min_cl'}=$changelists[0];
    $failures_infos{'max_cl'}=$changelists[$#changelists];
    if ($noretrack) {
      my $solved_failures='';
      my $pending_failures='';
      my $new_failures='';
      for (keys %failures) {
        my $failure_key=$_;
        if ($failures{$failure_key}{'Old_issue'} == 0 
            and $failures{$failure_key}{'Status_flag'} > 0) {
           $solved_failures.=" $failure_key";
        }
        if ($failures{$failure_key}{'Old_issue'} == 1
      and $failures{$failure_key}{'Status_flag'} <= 0) {
           $pending_failures.=" $failure_key";
           $failures{$failure_key}{'Failure_type'}=$tests_infos{$failure_key}{'Failure_type'};
        }
        if ($failures{$failure_key}{'Old_issue'} == 0 
            and $failures{$failure_key}{'Status_flag'} <= 0) {
           $new_failures.=" $failure_key";
        }
      }
      if ($solved_failures) {
        $out_buffer .= " == Solved failures: ==".
                       "\n => $solved_failures\n" ;
        $out_buffer .= "\n" . "-" x 60 . "\n";
        $out_buffer .= "=" x 60 . "\n";
      }
      if ($pending_failures) {
        $out_buffer .= " == Pending failures (still not fixed): ==".
                       "\n => $pending_failures\n" ;
        $out_buffer .= "\n" . "-" x 60 . "\n";
        $out_buffer .= "=" x 60 . "\n";
      }
      if ($new_failures) {
        $out_buffer .= " == New failures: ==".
                       "\n => $new_failures\n" ;
        $out_buffer .= "\n" . "-" x 60 . "\n";
        $out_buffer .= "=" x 60 . "\n";
      }
      &update_tracker_failures;}

    &out_file( "$out_buffer" ) ;

    close TRACKREP ;

    if ($mail_report_flag > 0) {
      &mail_report;}
}
##########################################################################
sub do_we_run {
    # all logic about selecting given example for running - return true if SKIP;

    # marks are used if no $required_example is set
    # $after_execute==1 means that this checking is already done
    if ( $after_execute ) { return 0 ; }
    
    if ( ! $required_example ) {
  
  $n = lc(substr($mark_label,0,1));
  if ( $n lt "a" || $n gt "z" ) {
      $why = "marked out $n"; return 1 ;
  }
  #if keywords set, use keywords markings only
  if ( $has_global_keywords ) {
      foreach $i (split(//,substr($mark_label,1))) {
    push ( @local_keywords,$i ) ;
      }
      # print " --lockey=" .join(':',@local_keywords) . "\n" ;

      if ( not @local_keywords ) {
          $out_buffer .= sprintf("no keyword for this test");return 1;
        }
      if ( &eval_keywords ) {
                $out_buffer .= sprintf("Using test keywords test in: @local_keywords\n");
#   print "Using test keywords test in: @local_keywords\n" ;
      } else {
                $out_buffer .= sprintf("no keyword match");return 1;
#   $why = "no keyword match" ; return 1;
      }
  } else {
      # single letter marks:
      
      # test speed condition
      $n = lc(substr($mark_label,0,1));
      if ( $strict_speed && ( $n ne $speed ) ) {
    $why = "wrong speed" ; return 1 ;
      }
      if ( $n gt $speed ) { $why = "too long: $n gt $speed" ; return 1; }
      # test subset condition
      if ( length($mark_label) > 1 ) {
    $n = substr($mark_label,1);
      } else {
    $n = "" ;
      }
      # if $run_mark is given - run only those matching
      if ( $run_mark ) {
    if ( ! $n ) { $why = "not marked" ; return 1; }
    if ( $run_mark !~ /[$n]/ ) {
        $why = "marks not match: $n ne $run_mark"; return 1; 
    }elsif ( uc($run_mark) =~ /[$n]/ ){
        $why = "marks with exclusion: $n "; return 1; 
    }
      #  } else {
    # else run only those without CAPS mark
    # if ( lc($n) ne $n ) { $why = "marked with caps: $n" ; return 1; }
      }
      if ( $echo_marks ) {
    print "Using test with mark $mark_label\n" ;
      }
  }
    }
# run list check
    if ( $run_list  ) {
        # run_list is filtered by keywords and marks if present

  if ( $list_id eq "" ) { return 1; }
  $tmp1 = index($full_test_id, ".");
  if ( $tmp1 > 0 ) {
      $test_fil = substr($full_test_id, 0, $tmp1);
      $test_id = substr($full_test_id, $tmp1+1);
  } else {
      $test_id = $full_test_id;
      $test_fil = "0";
  }

      AGAIN_LIST:
# print "TEST RUN LIST $full_test_id :: $test_fil;$test_id  $list_fil;$list_id ..$cur_list \n";

  if ( $test_fil < $list_fil ) { goto BELOW_LIST; }
  if ( $test_fil == $list_fil ) {
      if (  $test_id < $list_id ) { goto BELOW_LIST; }
      if (  $test_id == $list_id ) { goto LIST_DOIT; }
  }
  # here we are above list item
  if ( $cur_list eq "" ) { return 1; }
  if ( substr($cur_list, 0, 1) eq "-" ) {
      &get_next_list_id ( $cur_list ) ;
      $list_match = "<";
      goto AGAIN_LIST;
  }
  &get_next_list_id ( $cur_list ) ;
  $list_match = "=";
  goto AGAIN_LIST;
    
  # return 1;

      BELOW_LIST:
  if ( $list_match eq "=" ) { return 1; }
  if ( $list_match eq "<" ) { goto LIST_DOIT; }
  die "Bad list match" ;
      LIST_DOIT:
  
    }

    # XXXXXX qa_script with path (--test_name) not expected behaviour
    # No run list, if we asked for a model by its name (option --test_name) or for a path (option --test_path), we must check if the model is the current one else we skip
    # We do that here because for test that have only starter step, doing it later (as it was done by default) doesn't work
    else { 
        my @tmp_tab=split('/',$fem_file);
        pop @tmp_tab;
        my $tmp_test_path=join('/',@tmp_tab);
        $tmp_test_path=~s/\/$//;
        $tmp_test_path=~s/\/data$//;

        if ($test_name_requested) {
            if (not $tmp_test_path eq "$test_name_requested")  { 
                return 1;            
            }
            else {
                return 0;
            }
        }              

        elsif ($test_path_requested) {
            if (index($tmp_test_path,$test_path_requested) < 0) { 
                return 1;
            }
            else {
                return 0;
            }        
        }
    }
    # END XXXXXX

    if ( $skip_becse_require && $quiet == 0 ) {
  &out_file("** Skip test $full_test_id because of missing file $skip_becse_require.\n" );
  $skip_becse_require = "";
  return 1;
    }
  
# run list check <<< end
    return 0;

}

#################################################### READ_CONST_FILE
sub read_const_file () {
#
# process the or_QA.constants
#
# &out_file ( "    Processing file : $qa_constants_file \n\n" );
#
# initialize tolerances for extract data
#
$diff_tolerance      = 0 ;   # the default
$diff_tolerance_orig = 0 ;   # the default
$warn_tolerance      = 0 ;   # the default
$warn_tolerance_orig = 0 ;   # the default
$zero_tolerance      = 0 ;   # the default
$zero_tolerance_orig = 0 ;   # the default
$scale_factor_delta_vs_emax         = 0 ;
$scale_factor_delta_vs_emax_orig    = 0 ;
$scale_factor_emax         = 0 ;
$scale_factor_emax_orig    = 0 ;
$rel_int_tolerance      = 0 ;   # the default
$rel_int_tolerance_orig = 0 ;   # the default
$abs_int_tolerance      = 0 ;   # the default
$abs_int_tolerance_orig = 0 ;   # the default

@stack_local          = () ; # saves 'local varname' data
@stack_global         = () ; # save  'global varname' data
$global_slen          = 0  ; #   -""- len after QA.const
@match_local          = () ; # save  'local' varname Match
@match_global         = () ; # save  'global' varname Match
$global_mlen          = 0  ; #   -""- len after QA.const

#
# Read the or_QA.constants file
# Valid lines :
#    Diff_Tolerance {decimal number}
#    Zero_Tolerance {decimal number}
#    Int_Tolerance  {number}
#    Max_Integr     {number}
#    setenv {variable} {value}   <- you can set ANY variable like this.
#    unsetenv {variable}         <- you can unset ANY variable like this.
#    extension   (.fem for OS, .tcl for PHLEX)
#    use_reset_tolerances        <- PHLEX uses explicit Reset...Tolerance
@delete_ext = ();
@save_ext   = ();

#############################################################

@tnames = ($qa_constants_file, $qa_constants_file . ".local");
foreach $fconname (@tnames) {
    $cur_file_name = $fconname ;

if ( open (CONST, "< $fconname") || open (CONST, "< ../$fconname") ) {
    $infile = CONST;
while (<CONST>) {

    chomp ;

    if ( /^\s*if/ ) { $_ = &process_if ( $_ ); }
   
    next if (/^\s*\#|^\s*$/) ;  # Ignore comments and blank lines.

   if (/^\s*Relative_Int_Tolerance\s+([\d.]+)\s*$/) {
      # set the tolerance.
      $rel_int_tolerance = $1 ;
      $rel_int_tolerance_orig = $1 ;
   } elsif (/^\s*Int_Tolerance\s+([\d]+)\s*$/) {
      # set the tolerance.
      $abs_int_tolerance = $1 ;
      $abs_int_tolerance_orig = $1 ;
   } elsif (/^\s*Diff_Tolerance\s+([\d.e+-]+)\s*$/) {
      # set the tolerance.
      $diff_tolerance = $1 ;
      $diff_tolerance_orig = $1 ;
   } elsif (/^\s*Warn_Tolerance\s+([\d.e+-]+)\s*$/) {
      # set the tolerance.
      $warn_tolerance = $1 ;
      $warn_tolerance_orig = $1 ;
   } elsif (/^\s*Zero_Tolerance\s+([\d.e+-]+)\s*$/) {
      # set the tolerance.
      $zero_tolerance = $1 ;
      $zero_tolerance_orig = $1 ;
   } elsif (/^\s*Scale_Factor_Delta_Vs_Emax\s+([\d.e+-]+)\s*$/) {
      # set the tolerance.
      $scale_factor_delta_vs_emax = $1 ;
      $scale_factor_delta_vs_emax_orig = $1 ;
   } elsif (/^\s*Scale_Factor_Emax\s+([\d.e+-]+)\s*$/) {
      # set the tolerance.
      $scale_factor_emax = $1 ;
      $scale_factor_emax_orig = $1 ;
   } elsif (/^\s*Max_Integer\s+([\d]+)\s*$/) {
      # set the MAX_INT
      $biggest_int = $1 ;
      
   } elsif (/^\s*extension\s+(\S+)\s*$/) {
      # change default extension
      $input_ext = $1 ;
   } elsif (/^\s*use_reset_tolerances\s*$/) {
      # PHLEX uses Reset....
      $use_reset_tolerances = 1;
      
   } elsif (/^\s*--version\s*$/) {
      $print_version = 1;
      
   } elsif (/^\s*--args=(.*\S)\s*$/) {
      $user_prog_args .= " " . $1;
      
   } elsif (/^\s*addenv\s+(\S+)\s+(\S.*\S)\s*$/) {
      # do a setenv for this variable.
      eval "\$ENV\{$1\} = \"\$ENV\{$1\}:$2\"" ;
      if($debug>1){
          print "eval \"\$ENV\{$1\} = \"\$ENV\{$1\}:$2\"\"\n" ;
          print "setenv $1 $ENV{$1}\n" ;
      }
   } elsif (/^\s*setenv\s+(\S+)\s+(\S.*\S)\s*$/) {
      # do a setenv for this variable.
      eval "\$ENV\{$1\} = \"$2\"" ;
      if($debug>1){
          print "eval \"\$ENV\{$1\} = \"$2\"\"\n" ;
          print "setenv $1 $ENV{$1}\n" ;
      }

   } elsif (/^\s*setenv\s+(\S+)\s+(\S)\s*$/) {
      # do a setenv for this variable - when single letter value.
       # cygwin (1.5.25) has issues with (\S.*) - eats 1st letter of $1
      eval "\$ENV\{$1\} = \"$2\"" ;
      if($debug>1){
          print "eval \"\$ENV\{$1\} = \"$2\"\"\n" ;
          print "setenv $1 $ENV{$1}\n" ;
      }
       
   } elsif (/^\s*save\s+(\S.*\S)\s*$/) {
      # List file extensions to preserve
       push ( @save_ext, $1 );
       
   } elsif (/^\s*save_location\s+(\S.*\S)\s*$/) {
       $j = $1 ;
       @a = split (/\s+/,$j ) ;
       $i = $#a ;
       @a = split (/\//,$j) ;
       if ( $#a > 0 ) {
     die "ERROR in $cur_file_name: save_location contains \"/\"\n" ; }
       @a = localtime;
       $today = sprintf( "%02d%02d%02d" , $a[5]-100, $a[4]+1, $a[3] );
       $timenow = sprintf( "%02d%02d" , $a[2], $a[1] );
       $j =~ s/DATE/$today/g ;
       $j =~ s/TIME/$timenow/g ;
       $j =~ s/HOST/$hostname/g ;
       if ( $i == 0 ) {
     $save_folder = $j;
       } elsif ( $i == 3 ) {
     ( $screen_output_dir, $out_files_dir, $extracted_data_dir,
       $saved_files_dir ) = split (/\s+/,$j ) ;
       } else {
     die ("ERROR in $cur_file_name: save_location is bad\n");
       }
    
   } elsif (/^\s*delete\s+(\S.*\S)\s*$/) {
      # List file extensions to preserve
       push ( @delete_ext, $1 );
       
   } elsif (/^\s*cleanup_files\s+(\S.*\S)\s*$/) {
      # Files glob pattern deleted before each run
      @cleanup_files = split(/\s+/,$1) ;
       
   } elsif (/^\s*expectfile\s+(\S.*\S)\s*$/) {
      # List file names generated by exec
       push ( @expectfile, $1 );
       
   } elsif (/^\s*expectfileext\s+(\S.*\S)\s*$/) {
      # List file name extensions generated by exec
       push ( @expectfileext, $1 );
       
   } elsif (/^\s*extract_path\s+(\S.*\S)\s*$/) {
       # Local path for extract files
       $extract_path = $1 ;
   } elsif (/^\s*skip_lines\s+(\S.*\S)\s*$/) {
       # Local path for extract files
       if ( ! $skipfmt ) {  # command line overwrites
     $skipfmt = $1 ; }
   } elsif (/^\s*use_skip_lines\s*$/) {
       $usecqaext    = 1;
   } elsif (/^\s*extract_name\s+(\S.*\S)\s*$/) {
       # extract name generated by solver
       $local_run_extract = $1 ;
       
   } elsif (/^\s*exec_in_place\s*$/i) {
       $exec_in_place = 1;
       
   } elsif (/^\s*exec_script\s+(\S.*\S)\s*$/) {
       # exec_script can be defined in the CONST file
       $exec_script = $1 ;

   } elsif (/^\s*show_extract_full\s*$/i) {
       $show_extract_full = 1;
##### !!!!! dbg_stopqa_infos_extract
   } elsif (/^\s*echo-radioss\s*$/) {
      $echo_radioss = 1;
   } elsif (/^\s*echo-radioss-tolerances\s*$/) {
      $echo_radioss_tolerances = 1;
   } elsif (/^\s*sandbox\s+(\S.*\S)\s*$/) {
       # exec_script can be defined in the CONST file
       $sandbox = "Sandbox.".$1 ;

   } elsif (/^\s*rename_input\s+(\S.*\S)\s*$/) {
       $local_fem_file = $1 ;
       
   } elsif (/^\s*global\s+(\S+)\s+match\s*$/i) {
       $has_match = 1 ;
       $global_mlen = push ( @match_global, $1 );
   } elsif (/^\s*global\s+(\S.*\S)\s*$/i) {
       $has_stack = 1 ;
       $global_slen = push ( @stack_global, $1 );
       
   } elsif ( /^\s*keywords=(.+)/ ) {
       $has_global_keywords = 1;
       &store_keywords ( $1 );
   } elsif (/^\s*unsetenv\s+(\S+)\s*$/) {
      # do a unsetenv for this variable.
      if ( $ENV{$1} ) {
    delete $ENV{$1} ;
      }
      if($debug>1){
        print "unsetenv $1\n" ;
      }
      
   } elsif (/^\s*then\s*$/i) {
       $within_else = 1;
       # execute to next line with 'else' or 'endif' in the file
       
   } elsif (/^\s*else\s*(if.*)?\s*$/i) {
       &skip (1);
       # skip to next line with 'endif' in the file
       
   } elsif (/^\s*endif\s*$/i) {
       # do nothing - this line is just placeholder
       if ( $within_else == 0 ) {
     die ( "$cur_file_name: Endif not in if/then/else" ); }
       $within_else = 0;
     
   } else {
       warn "Unknown line in $fconname \"$_\"\n" ;
   }

}
close (CONST) ;
} else {
    if ( $fconname eq $qa_constants_file ) {
  print "Could not find $fconname file.\n" ;
    }
}
} # foreach $fconname
# match $#stack_global
$global_slen--;
$global_mlen--;
   
if ( $local_fem_file eq "" ) {
    $local_fem_file = "run" . $input_ext; }
&save_tol('CONST');
}

###################################################### read_arg_options 
sub read_arg_options () {
while ( $ARGV[$tmp] ) {
    $a = $ARGV[$tmp] ;
    if ( $a =~ /^[0-9]/ ) { # number = required example
          if ( $a =~ /x$/ ) {
            $required_example = substr($a,0,length($a)-1) ;
          }
          else {
      if ( $required_example ) {
        # In the case we found several model list (separated with blank or qa_script options), we concatenate these list with a ,
        # But we don't allow to have a full QA .0 in this concatenation because it isprobably because of running a VerifQA with a new list set
        # So we don't want the full QA to be executed
        if ($required_example !~ /,/ and $required_example =~ /\.0$/) {
          $required_example = $a ;
        }
        else {
          if ($a !~ /\.0$/) {
            $required_example  .=  "," . $a ;
          }
        }

      } else {
        $required_example = $a ;
      }
      if ( length($a) < 7 ) { 
        $verbose = 1;
      }
          }
    } elsif ( $a =~ /^--/ ) { # option with minus signs
  if ( $a eq "--quiet" ) {
      $quiet = 1;
      $verbose = 0;
  } elsif ( $a eq "--perldebug" ) {
      $perldebug = "-d";
  } elsif ( $a eq "--debug" ) {
      $debug = 0;
  } elsif ( $a eq "--debug-stopqa" ) {
      $dbg_stopqa_infos_extract = 1;
  } elsif ( $a =~ /^--debug=/ ) {
      $debug = substr($a, 8 );
  } elsif ( $a eq "--fixed_tolerances" ) {
      $fix_tolerances = 1;
  } elsif ( $a eq "--strict" or $a eq "--strict2") {
      $fix_tolerances = 1;
            if ($a eq "--strict2") {
              $fix_tolerances = 2;
            }
      if ( $platform eq "NT" ) {
    $extract_suffix = "_wind" ;
      } elsif ( $uname ne "Linux" ) {
    print "Warning - unsupported strict platform ?\n" ;
      }
  } elsif ( $a eq "--clean" ) {
      &read_const_file ;
      &cleanup ;
      exit ;
  } elsif ( $a eq "--echo" ) {
      $force_echo = 1;
      $use_stdout = 1;
  } elsif ( $a eq "--log" ) {
      $force_echo = -1;
      $use_stdout = 1;
  } elsif ( $a eq "--atag" ) {
      $fix_atag = 1;
  } elsif ( $a eq "--atag_all" ) {
      $fix_atag = 1;
      $no_skip_atag = 1;
  } elsif ( $a eq "--clean-all" ) {
      &read_const_file ;
      &cleanall ;
      exit ;
  } elsif ( $a eq "--overwrite_extract" ) {
      $force_extract_overwrite = 1 ;
      $sanity_stop      = 0 ;
  } elsif ( $a =~ /^--add_ext..ct/ ) {
      $add_missing_extract  = 1 ;
      $ENV{"CHECK_QA"}="ON"; # force checks of diag/echo on new examples
      $sanity_stop      = 0 ;
      $search_for_nan = 1; # force checks of NaN on new examples
            if ($qadiags_content == 1) {
        $qacards .= ":syssettings,syntax=strict"; # require strict Nastran
            }
  } 
  # XXXXXX QA ERRORS and WARNINGS
  elsif ( $a =~ /^(--extract_from_starter=.+)/ ) {
      $extract_from_starter = $1;
  }   
  # END XXXXXX
  elsif ( $a eq "--check_qa" ) {
      $ENV{"CHECK_QA"}="ON"; # force checks of diag/echo
            if ($qadiags_content == 1) {
        $qacards .= ":syssettings,syntax=strict"; # require strict Nastran
            }
      $search_for_nan = 1; # force checks of NaN
  } elsif ( $a eq "--verbose" ) {
      $verbose = 1;
      $expverbose = 1;
      $quiet = 0;
  } elsif ( $a eq "--stdout" or $a eq "--iout") {
      $use_stdout = 1;
  } elsif ( $a eq "--save_out_files" ) {
      $save_out_files = 1;
  } elsif ($a eq "--show_extract_full") {
       $show_extract_full = 1;
       $show_extract = 1;
       $verbose = 1;
  } elsif ( $a =~ /^--show_extract/ ) {
      $show_extract = 1;
      $verbose = 1;
  } elsif ( $a eq "--version" ) {
      $print_version = 1;
  } elsif ( $a eq "--nan" ) {
      $search_for_nan = 1;
  } elsif ( $a =~ /^--args=/ ) {
      $user_prog_args .= " " . substr($a,7) ;
  } elsif ( $a eq "--echo_marks" ) {
      $verbose = 1;
      $echo_marks = 1;
  } elsif ( $a eq "--check_timings" ) {
      $timing_check = 1;
      $quiet = 1;
  } elsif ( $a =~ /^--check_timings=/ ) {
      $timing_check = 1;
      $quiet = 1;
      $margin = substr($a,16) ;
  } elsif ( $a eq "--double_check" ) {
      $double_check = 1;
  } elsif ( $a =~ /^--repeat_qa=/ ) {
      $repeat_qa=substr($a, 12, 2);
  } elsif ( $a =~ /^--track_failures=/ ) {
      $changelist_minimum = substr($a, 17 );
  } elsif ( $a =~ /^--track_steps=/ ) {
      $track_steps = substr($a, 14 );
  } elsif ( $a =~ /^--clean_failures_all$/ ) {
      qx(rm -f tracker.failures_*);
  } elsif ( $a =~ /^--clean_failures$/ ) {
      $clean_failures=1;
  } elsif ( $a eq "--fix_qa_files" ) {
      $fix_qa_files = 1;
  } elsif ( $a eq "--list_only" ) {
      $skip_tests = 1 ;
      $verbose = 1;
  } elsif ( $a  =~ /^--translator=/ ) {
      $translator = substr($a,13) ;
  } elsif ( $a eq "--safe" ) {
      $safe_run = 1 ;
  } elsif ( $a eq "--local" ) {
      &local_dir ;
  } elsif ( $a eq "--exec_in_place" ) {
      $exec_in_place = 1;
  } elsif ( $a  =~ /^--dir=(.+)/ ) {
      &run_in_dir ( $1 ) ;
  } elsif ( $a =~ /^--files=/ ) {
      $required_example = substr($a,8) ;
  } elsif ( $a =~ /^--dbx=/ ) {
      $debugger_command = substr($a,6) ;
      $run_debugger = 1 ;
  } elsif ( $a =~ /^--extract_suffix=/ ) {
      $extract_suffix = substr($a, 17 );
  } elsif ( $a =~ /^--timeout=/ ) {
      $timeout = substr($a, 10 );
  } elsif ( $a =~ /^--echo_test/ ) {
      $echo_test = 1;   
  } elsif ( $a =~ /^--env:(\S+)=(.+)/ ) {
      if ( "$2" eq "" ) {
    delete $ENV{$1} ;
      } else {
    $ENV{$1}="$2";
                print "Environment variable :\n => $1=$2\n"
      }
 } elsif ( $a =~ /^--addenv:(\S+)=(\S*)/ ) {
  $ENV{$1}=$ENV{$1}."$2";
                print "Environment variable :\n => $1=$ENV{$1}\n"
  } elsif ( $a =~ /^--keywords=(.+)/ ) {
      $has_global_keywords = 1;
      &store_keywords ( $1 );
  } elsif ( $a =~ /^--self_reference=(.+)/ ) {
      $selfreference    = "$1";
      $selfref_pass     = 1;
  } elsif ( $a =~ /^--hwsolvermanager$/ ) {
      $hwsolvermanager = 1;
  } elsif ( $a =~ /^--hwsolvermanager_args=(.+)/ ) {
      $hwsolvermanager_args      = "$1";
  } elsif ( $a =~ /^--exec_script=(.+)/ ) {
      $exec_script      = "$1";
  } elsif ( $a =~ /^--exec_script_args=(.+)/ ) {
      $exec_script_args = "$1";
  } elsif ( $a =~ /^--preqa_run=(.+)/ ) {
      $preqa_run        = "$1";
  } elsif ( $a =~ /^--postqa_run=(.+)/ ) {
      $postqa_run       = "$1";
  } elsif ( $a =~ /^--no_sanity_stop/ ) {
      $sanity_stop      = 0 ;
  } elsif ( $a =~ /^--check_newfile/ ) {
      $check_newfile    = 1 ;
  } elsif ( $a =~ /^--trim_diffs/ ) {
      $full_diffs      = 0 ;
  } elsif ( $a =~ /^--use_cqa/ ) {
    $usecqaext        = 1;
  } elsif ( $a =~ /^--skip_lines=(.+)/ ) {
    $usecqaext        = 1;
    $skipfmt          = $1;
  } elsif ( $a =~ /^--mpiqa/ ) {
      $runmpiqa        = 100; #use given path and mpirun
  } elsif ( $a =~ /^--plmpiqa/ ) {
      $runmpiqa        = 9;
  } elsif ( $a =~ /^--hpmpiqa/ ) {
      $runmpiqa        = 3;
  } elsif ( $a =~ /^--msmpiqa/ ) {
      $runmpiqa        = 8;
  } elsif ( $a =~ /^--itmpiqa/ ) {
      $runmpiqa        = 6;
  } elsif ( $a =~ /^--nightlyqa=(.+)/ ) {
      $nightlyqa       = "$1" ;
      $print_version   = 1;
  } elsif ( $a =~ /^--branch=(.+)/ ) {
      $rptbranch       = "$1" ;
  } elsif ( $a =~ /^--list_noerrqa=(.+)/ ) {
      $noerrqafile    = "$1" ;
  } elsif ( $a =~ /^--qacards=(.+)/ ) {
      $qacards        .= ":" .$1;
  } elsif ( $a =~ /^--crlf/ ) {
      $doslines = 1;
  } elsif ( $a =~ /^--qa_skip_list=/ ) {
      $ff = substr($a, 15);
      if ( open (FAILURES, "< $ff" ) ) {
    $qa_skip_list = <FAILURES> ;
    close FAILURES ;
    chomp($qa_skip_list);
    print "Skipping examples from file \"$ff\":\n $qa_skip_list\n" ;
    $qa_skip_list = " ".$qa_skip_list." ";
      }
  } elsif ( $a =~ /^--paraqa(=)?(.*)/ ) {
            if ( $2 ) {
                $paraqa = $2;
            } else {
                $paraqa = 1;
            }
    } elsif ( $a =~ /^--tracker_shortcut_limits=(.+),(.+)/ ) {
        $tracker_shortcut_max_cls = $1;
        $tracker_shortcut_max_failures = $2;
    } elsif ( $a =~ /^--sensitivity_check/ ) {
        $sensitivity = 1;
    } elsif ( $a =~ /^--sensitivity_n=(.*)/ ) {
        $sensitivity = 1;
        $sensitivity_n=$1;
    } elsif ( $a =~ /^--sensitivity_xalea=(.*)/ ) {
        $sensitivity = 1;
        $sensitivity_xalea=$1;
    } elsif ( $a =~ /^--sensitivity_i8/ ) {
        $sensitivity_i8 = 1;
    } elsif ( $a =~ /^--sensitivity_set_extract/ ) {
        $sensitivity_set_extract = 1;
    } elsif ( $a =~ /^--sensitivity_set_recommended_tolerances_submit/ ) {
        $sensitivity_set_recommended_tolerances = 1;
        $sensitivity_set_recommended_tolerances_submit = 1;
    } elsif ( $a =~ /^--sensitivity_set_recommended_tolerances/ ) {
        $sensitivity_set_recommended_tolerances = 1;
    } elsif ( $a =~ /^--sensitivity_no_constraint/ ) {
        $sensitivity_no_constraint = 1;
    } elsif ( $a =~ /^--no_random/ ) {
        $no_random = 1;
    } elsif ( $a =~ /^--keep_results_dir=(.*)/ ) {
        $keep_results = 1;
        $keep_results_dir = $1;
    } elsif ( $a =~ /^--keep_results/ ) {
        $keep_results = 1;
    } elsif ( $a =~ /^--create_ref=(.*)/ ) {
        $create_ref = $1;$keep_results = 1;
    } elsif ( $a =~ /^--test_path=(.*)/ ) {
        $test_path_requested = $1;
    } elsif ( $a =~ /^--test_name=(.*)/ ) {
        $test_name_requested = $1;
    } elsif ( $a =~ /^--noretrack$/ ) {
        $noretrack = 1;
    } elsif ( $a =~ /^--mail_report=(.*)/ ) {
        $mail_report_flag = $1;
    } elsif ( $a =~ /^--dbgout/ ) {
        $use_stdout = 1;
        $dbgout = 1;
  $xtra_args_add .= " --dbgout" ;
    } elsif ( $a =~ /^--xtra_args=(.*)/ ) {
        $xtra_args_add .= " $1" ;
    } elsif ( $a =~ /^--full_track/ ) {
        $nofull_track = 0;
    } elsif ( $a =~ /^--no_count_timeout/ ) {
        $no_count_timeout = 1;
    } elsif ( $a =~ /^--notrack_timeout/ ) {
        $notrack_timeout = 1;
    } elsif ( $a =~ /^--no_check_emax/ ) {
        $no_check_emax = 1;
    } elsif ( $a =~ /^--tests_titles/ ) {
        $tests_titles = 1;
    } elsif ( $a =~ /^--tracker_failures_suffix=(.*)/ ) {
        $tracker_failures_suffix = $1;
    } elsif ( $a =~ /^--tracker_failures_suffix_ref=(.*)/ ) {
        $tracker_failures_suffix_ref = $1;
    } elsif ( $a =~ /^--output_failures_stdout$/ ) {
        $output_failures_stdout = "60,100";
    } elsif ( $a =~ /^--output_failures_stdout=(.*)/ ) {
        $output_failures_stdout = $1;
#        $xtra_args_add .= " --output_failures_stdout";
    } elsif ( $a =~ /^--system_run$/ ) {
        $system_run = 1;
    } elsif ( $a =~ /^--input_check_script=(.*)/ ) {
        $input_check_script = $1;
    } elsif ( $a =~ /^--output_xtra_infos$/ ) {
        $output_xtra_infos = 1;
        $xtra_args_add .= " --output_xtra_infos";
    } elsif ( $a =~ /^--real_exe_dir=(.*)/ ) {
        $real_exe_dir = $1;
    } 
    # XXXXXX Check ERRORS in screen_save (in addition to diff in ref.extract) + Check bounds (ignore diff in ref.extract)
    # Add new options
    elsif ( $a =~ /^--ignore_extract_comparison/ ) {
        $ignore_extract_comparison = 1;
    } 
    elsif ( $a =~ /^--ignore_check_errors/ ) {
        $ignore_check_errors = 1;
    } 
    # End XXXXXX
    else {
            if ( $a ) {
            print "Unknown arg : $a\n\n"; }
    print "Usage: $prog_name executable [qa_file] [dbx] [options]\n" ;
    print "   $prog_name exec [qa_file:flags]...\n" ;
    print "   $prog_name exec [qa_file:testid]...\n" ;
    print "   $prog_name exec [qa_file] [[:]flags]...\n" ;
    print "   $prog_name exec [qa_file] [[:]testid]...\n\n" ;
    print " <exec> is the only required argument\n";
    print " Any unrecognized argument after <exec> without \'--\'";
    print " is assumed to be:\n";
    print " - example id list, if it starts with a digit\n";
    print " - debugger name, if it starts with lowercase letter\n";
    print " - qa_file name, if is starts with \'Q\'\n";
    print " - flags, if is starts with capital letter\n\n";
    print " [exec] can be \'.\' then last run exec will be reused\n";
    print "  otherwise exec is copied locally as $local_executable\n";
    print "  (except for single test run).\n";
    print " [qa_file] can be skipped and defaults to or_QA.files_all\n";
    print " [dbx] actual name of your debugger: dbx|gdb|dde|...\n\n";
    print " [flags]: c   run all long tests\n" ;
    print " [flags]: B   run all medium and shorter tests\n" ;
    print " [flags]: Xb  run all tests in group b (QA_long)\n" ;
    print " [flags]: Ba  run short tests in group a (QA_fast)\n" ;
    print " [flags]: xbfl run all tests in groups b, f or l\n\n" ;
    print "   default flags are Xab (Xabf for list of testids)\n" ;
    print "   flags are not used for a single run.\n" ;
    print "   CAPS in group letters are not allowed\n" ;
    print " [testid]: numeric value ( 12, 4.5 runs one test\n" ;
    print "           12.0 will run specified include file\n" ;
    print "           10.1,10.6-11.3,11.5 will run a list)\n" ;
    print "      @ - run recent failed tests (file .qa_fail_list).\n";
    print "      @\"filename\" - run examples listed in file\n" ;
    print " [options] are: \n";
    print "\t--verbose --quiet\n";
    print "\t--args=\"whatever_needed\"\n" ;
    print "\t--env:NAME=value \n" ;
    print "\t--echo --log (adds \'-out\' or \'-log\' to arg list)\n" ;
    print "\t--fixed_tolerances, --strict\n" ;
    print "\t--extract_suffix=<suffix> \n" ;
    print "\t--extract_from_starter=<rules file> - extract information from starter output file according to specific rules and put them in the RD extract file\n";
    print "\t--overwrite_extract\n" ;
    print "\t--add_extract (for new tests)\n" ;
    print "\t--keywords=aaa,bbb,or,not,ddd,ff,or,and(RPN) aaa,-bbb\n" ;
    print "\t--save_out_files (even if no fail),work /w or_QA.constants\n" ;
    print "\t--stdout (shows, not saves stdout)\n" ;
    print "\t--nan (search stdout and out)\n" ;
    print "\t--show_extract (even if no diffs)\n" ;
    print "\t--trim_diffs - failure prints no more than 10 lines\n";
    print "\t--list_only (do not execute tests)\n" ;
    print "\t--dbx=debugger_command\n" ;
    print "\t--timeout=n (seconds)\n" ;
    print "\t--version report exec version in QA.summary\n" ;
    print "\t--clean[-all]  housecleaning\n" ;
    print "\t--check_timings\n" ;
    print "\t--fix_qa_files - create or_QA.files.bak with good marks\n" ;
    #     print "\t--atag --atag_all\n" ; valid but not documented
    print "\t--check_qa - check for diags/echo/incl qadiags\n" ;
    print "\t--crlf - check out files for not-clean-ASCII\n" ;
    print "\t--exec_in_place\n" ;
    print "\t--exec_script=name (perl script to call exec)\n" ;
    print "\t--exec_script_args=\"...\" \n" ;
    print "\t--preqa_run=\"name args\" --postqa_run=\"name args\" \n";
    print "\t--double_check (rerun failures at end)\n" ;
    print "\t--repeat_qa=n (repeat the whole run n times\n";
    print "\t--track_failures=<earliest changelist or negative #>\n" ;
    print "\t--safe (make ../Scratch_X/ if needed)\n" ;
    print "\t--dir=<PATH>  --local \n" ;
    print "\t--echo_test (special mode for ECHO) \n" ;
    print "\t--translator=\"script\" \n" ;
    print "\t--debug<=n> \n" ;
    print "\t--skip_lines='(Volum|Mass)' skip extract lines before compare\n" ;
    print "\t--qa_skip_list=\"filename\" skip examples listed in the file\n" ;
    print "\t--no_sanity_stop (run till the end even if all fail)\n" ;
    print "\t--mpiqa run parallel qa using predefined MPI\n" ;
    print "\t--plmpiqa run parallel qa using Platform MPI\n" ;
    print "\t--hpmpiqa run parallel qa using HP MPI\n" ;
    print "\t--itmpiqa run parallel qa using Intel MPI\n" ;
    print "\t--msmpiqa run parallel qa using Microsoft MPI\n" ;
    print "\t--nightlyqa=changelist used only in the nightly qa\n" ;
    print "\t--branch=User_Defined_Branch_Name used only for qa database\n" ;
    print "\t--list_noerrqa=User_Defined_File_Name which contains non err qa list\n" ;
    print "\t--qacards=cards:card add to qadiags.inc in this run\n" ;
    print "\t--check_newfile check if any leftover\n" ;
    print "\t--tracker_shortcut_limits=max_cls,max_failures\n" ;
    print "\t--sensitivity_check perform a sensitivity study by running several times each test\n" ;
    print "\t--sensitivity_set_recommended_tolerances automatically insert proposed tolerances into the related or_QA.files if they respect the rule from qa_sensitivity_contraints\n";
    print "\t--sensitivity_set_recommended_tolerances_submit same as --sensitivity_set_recommended_tolerances, in addition submit the changes on perforce\n";
    print "\t  default values are N=10 and Xalea=1e-6\n" ;
    print "\t--sensitivity_n=[N] set up N value for sensitivity (sensitivity is activated)\n" ;
    print "\t--sensitivity_xalea=[Xalea] set up Xalea value for sensitivity (sensitivity is activated)\n" ;
    print "\t--sensitivity_i8 handle i8 format\n" ;
    print "\t--keep_results save new files into my_results directory\n" ;
    print "\t--keep_results_dir=[my_dir] save new files into my_dir directory\n" ;
    print "\t--test_name=[my_dir] run only test equal to path\n" ;
    print "\t            (example : mydir=../miniqa/ACCELEROMETRES\n" ;
    print "\t--test_path=[my_dir] run all tests matching path\n" ;
    print "\t            (example : mydir=../tests/default/AIRBAG\n" ;
    print "\t--noretrack does not retrack failures identified by the tracker.failures file\n" ;
    print "\t--no_count_timeout does not count timeout into failures counter\n" ;
    print "\t--notrack_timeout does not retrack tests identified by a timeout\n" ;
    print "\t--sensitivity_set_extract in case of sensitivity analysis : set extract file to suggested extract file\n" ;
    print "\t--create_ref=[i] : keep additional files\n" ;
    print "\t 1:listings only\n" ;
    print "\t 2:1+time history, abf files\n" ;
    print "\t 3:2+last anim\n" ;
    print "\t 4:3+first anim, hd3\n" ;
    print "\t 5:3+all anim, hd3\n" ;
    print "\t--output_failures_stdout\n" ;
    print "\t--output_failures_stdout=20,100\n" ;
    print "\t  print stdout in case of failure\n" ;
    print "\t--tests_titles\n" ;
    print "\t  print TEST titles\n" ;
    print "\t--output_xtra_infos\n" ;
    print "\t  print additional information (implicit, txt files, ...)\n" ;
    print "\t--no_check_emax disable check using emax (for both run and sensitivity)\n";
    print "\t--real_exe_dir the way to access the real exe, useful when binaries are local, but tracker must browse remotely (e.g. set X:/ to replace D:/ with it for the tracker)\n";
    print " file QA.exec_name to change default exec storage.\n" ;
    exit ;
  }
    } elsif ( $a =~ /^:/ && length($a) > 1 ) { # standalone code :XX
  if ( $a =~ /[0-9]/ ) {
      $required_example = substr( $a, 1);
        $test_group=$required_example;
      if ( length($a) < 8 ) { 
    $verbose = 1;
      }
  } else {
      $run_mark = substr( $a, 1);
  }
    } elsif ( $a =~ /^@/ ) {
  $ff = $failure_file;
  $run_err_list = 1;
  if ( $a ne "@" ) {
      $ff = substr($a, 1);
  }
  if ( open (FAILURES, "< $ff" ) ) {
      $required_example = <FAILURES> ;
      chomp($required_example);
      close FAILURES ;
      if ( $a eq "@" ) {
    print "Executing last failures: $required_example\n" ;
      } else {
    print "Executing examples from file \"$ff\": $required_example\n" ;
      }
  }
    } else { # real arguments: code, QA.file, Xab, dbx
  if ( $n == 0 ) { 
      $executable      = $a ;
      $runargs_compute .= $executable;
      while ( -l $executable ) {
            # resolve symbolic link with real exec name
        $executable = readlink $executable;
      }
  } else {
      if ( "QA" eq substr( $a, 0, 2 ) ) {
    $qa_fem_files_file = $a ;
      } elsif ( lcfirst ( $a ) eq $a ) {
    # all lower case, it is debugger name
    $debugger_command = $a ;
    $run_debugger = 1 ;
      } else {
    # starts with caps, it is marks
    $run_mark = $a;
      }
  }
  $n ++ ;
    }
    $tmp ++ ;
}

if ($sensitivity == 1) {
  print " Sensitivity set on\n";
  if ($sensitivity_n == 0) {$sensitivity_n = 10}
  if ($sensitivity_xalea == 0) {$sensitivity_xalea = 1e-6}
  print "\tN=$sensitivity_n, Xalea=$sensitivity_xalea\n";
# cannot use self reference in case of sensitivity
  $selfref_pass=0;
  if ( $echo_test && ($usecqaext != 1) ) {
    $skipfmt = "(No_Warn|No_Warnings)"; # OptiStruct specific
    $usecqaext = 1 ;
  }
}


if ( $force_extract_overwrite || $add_missing_extract || $fix_atag ) {
    if ( $force_extract_overwrite && $add_missing_extract ) {
  die "Can\'t add- and overwrite- extracts in the same run.\n";
    }
    if ( $selfref_pass ) {
  print "$selfref_pass $force_extract_overwrite $add_missing_extract\n";
  die "ERROR: --selfreference with --add/--overwrite_extract\n";
    }
}

my $required_example1=&sort_ids($required_example);
if ( $required_example1 ne $required_example ) {
  print " Reorder test ids : \n\t$required_example\n\tto\n\t$required_example1\n";
  $required_example=$required_example1;
}

}   ### end read_arg_options
##########################################################################
sub sort_ids () {
  my ($list)=(@_);
  my ($tag_id_full,$tag_id_single)=(0,0);
  my @myids=split(',',$list);
  my @split_tab;
#  my @split_tab=map {[if (index( $_,'.' )) { substr( $_ , 0 , index( $_,'.' ) ) } else { $_ },substr( $_ , index( $_,'.' )+1 )] } @myids;

  # XXXXXX Adding possibility to mix full QA and list (e.g. "1.2,8.5-8.7,14.0")
  # If there is more than one element, we allow to replace full QA 1.0 by a range 1.1-1.89
  my $enable_fullqa_replace_by_range = 0;
  $enable_fullqa_replace_by_range = 1 if (scalar(@myids) > 1); 

  for my $id (@myids) {

    # XXXXXX Adding possibility to mix full QA and list (e.g. "1.2,8.5-8.7,14.0")
    # Goal is to replace 14.0 entry with a range 14.1-14.408, getting model number information in the include file directly
    if ($enable_fullqa_replace_by_range and $id =~ /(\d+)\.0/) {
      my $id_major = $1;
      my $qafile_include_name;

      # Identifying the include file
      open (QAFILE_ALL, "< $qa_fem_files_file") || die "$qa_fem_files_file: $!\n" ;
      my $found_qa_num = 0;
      while (<QAFILE_ALL>) {

        $found_qa_num and /include\s+(.*)$/ and do {
          $qafile_include_name = $1;
          last;
        };

        ! $found_qa_num and /^#\s*$id_major\s*$/ and do {
          $found_qa_num = 1;
        };

      }
      close (QAFILE_ALL);

      # Getting last model from the include file
      if (defined $qafile_include_name and -f $qafile_include_name) {
        $last_num = `grep '^test\\s\\+' $qafile_include_name | wc -l`;
        chomp $last_num;
        if ($last_num ne '') {
          $id = $id_major.'.1-'.$id_major.'.'.$last_num;
        }
      }
      else { 
        die "Cannot find valid or_QA.files related to $id";
      }

    }

    if (index( $id,'.' )>0) {
      $tag_id_full=1;
      push @split_tab,[substr( $id , 0 , index( $id,'.' ) ),substr( $id , index( $id,'.' )+1 )];
    }
    else {
      $tag_id_single=1;
      push @split_tab,[-1,$id];
    }
  }
  if ($tag_id_full and $tag_id_single) {
    print "ERROR: cannot mix full ids with single ids :\n";
    die join(',',@myids)."\n";
  }
  for my $id (@split_tab) {
    if (index($$id[1],'-') >= 0) {
      push @{$id},substr( $$id[1] , index( $$id[1],'-' )+1 );
      $$id[1]=substr( $$id[1] , 0 , index( $$id[1],'-' ));

    }
  }
  my @ids_sorted=sort { ($a)[0]->[0] <=> ($b)[0]->[0] || ($a)[0]->[1] <=> ($b)[0]->[1] } @split_tab;
  for my $val (@ids_sorted) {
    my $list_suffix="";
    my $size=@{$val};
    if ($size>2) { $list_suffix='-'.($val)[0]->[2] }
    my $val0=($val)[0]->[0].'.'.($val)[0]->[1].$list_suffix;
    if (($val)[0]->[0] == -1) {
      $val0=($val)[0]->[1].$list_suffix;
    }
    $val=$val0;
  }
  return join(',',@ids_sorted);
}
##########################################################################

sub process_if {
    #  input: line starting with 'if'
    #  output: remainder of line for single line if

AFTER_IF:
   if ( /^\s*(if|or|and)(\S*)\s*(\S+)\s*(\S+)\s*(\S+)\s*(\S.+)$/i ) {
       $cond = $4 ;
       $arg2 = $5 ;
       $line = $6 ;
       $env = $2 ;
       $patt = $3 ;
       $if_then = 0;   # this is single line if
       if ( /then\s*$/i ) { $if_then = 1; }  # this is if... then
       if ( $env eq "env" ) {
     if ( $ENV{$patt} ) {
         $patt = $ENV{$patt} ;
     } else {
         $patt = "" ;
     }
       }
       elsif ( $env ) {
     goto BAD_IF ;
       }
       elsif ( $patt =~ /^hostname$/i ) {
     $patt = $hostname ;
       }
       elsif ( $patt =~ /^selfreference$/i ) {
     $patt = $selfreference ;
     while ( substr ($patt , 0, 1 ) eq "-" ) {
         $patt = substr ($patt , 1 ); }
       }
       elsif ( $patt =~ /^uname$/i ) {
     $patt = $uname ;
       }
       elsif ( $patt =~ /^perlmode$/i ) {
     $patt = $perl_mode ;
       }
       elsif ( $patt =~ /^platform$/i ) {
     $patt = $platform ;
       }
       elsif ( $patt =~ /^module$/i ) {
     $patt = $executable ;
       }
       elsif ( $patt =~ /^precision$/i ) {
          if ($executable  =~ /_sp$/ or $executable  =~ /_sp.exe$/) {$patt = "sp"} else {$patt = "dp"} ;
       }
       elsif ( $patt =~ /^flags$/i ) {
     $patt = $run_mark ;
       }
       elsif ( $patt =~ /^timezone$/i ) {
     $patt = $timezone ;
       }
       elsif ( $patt =~ /^strict$/i ) {
     $patt = $fix_tolerances ;
       }
       elsif ( $patt =~ /^env$/i ) {
     $patt = "";
     if ( $ENV{$arg2} ) { $patt = $arg2 };
       }
       elsif ( $patt =~ /^file$/i ) {
     # this is different syntax for IF, not generic cond
     if ( $cond eq "-f" || $cond eq "-e" ) {
         if ( ! -e $arg2 ) { goto IF_FAIL ; }
     }
     elsif ( $cond eq "-z" ) {
         if ( ! -z $arg2 ) { goto IF_FAIL ; }
     }
     elsif ( $cond eq "-s" ) {
         if ( ! -s $arg2 ) { goto IF_FAIL ; }
     }
     elsif ( $cond eq "-n" ) {
         if (   -e $arg2 ) { goto IF_FAIL ; }
     }
     else {
         goto BAD_IF ;
     }
     goto IF_PASS ;
       } else {
     goto BAD_IF ;
       }
       # print "Pattern :$patt:\n" ;
       if ( $cond eq "=" || $cond eq "==" ||
      $cond =~ /^eq$/i || $cond =~ /^\.eq\./i ) {
     if ( $patt !~ /$arg2/i ) { goto IF_FAIL ; }
       } elsif ( $cond eq "!=" || $cond =~ /^ne/i || $cond =~ /^\.ne\./i ) {
     if ( $patt =~ /$arg2/i ) { goto IF_FAIL ; }
       } else {
     goto BAD_IF ;
       }
     IF_PASS:
       # print "Conditional satisfied :$_:\n" ;
       $_ = $line ;
       goto AFTER_IF ;
     IF_FAIL:
       # print "Conditional failed :$_:\n" ;
       $_ = $line ;
       if ( /^\s*or/i ) {  goto AFTER_IF ; }
       if ( $if_then ) {
     $line = skip(0);
     if ( $line =~ /^\s*if/i ) {
         $_ = $line ; goto AFTER_IF ; }
       }
       if ( $force_extract_overwrite ) {
     if ( $line =~ /extract/ ) {
         $extractinif = 1 ; }
       }  # this is not robust if new multi-line if/then/else is used
       return "";
       
   } 
   return $_ ;

 BAD_IF:
   print "Bad \'if\' in $cur_file_name: $_\nSkipping to \'endif\'\n" ;
   if ( $if_then ) { skip(1); }
   return "" ;
   
}
##########################################################################

sub cleanup_run_files {
    # These files are potential leftovers from the previous run
    my $tmp = $nono_files;
    my @tmp_cleanup_files=@cleanup_files;
    for my $i (@tmp_cleanup_files) {
        # line below to keep all logs in case of --output_failures_stdout
        if ($selfref_pass == 2 and $i =~ /^screen_save/) { next }
      if ( $i =~ /(\%)/ ) {
        if ( @all_root_cleanup ) {
          for my $myroot (@all_root_cleanup) {
            my $i1=$i;
            $i1 =~ s/\%/$myroot/g ;
            $tmp .= " $i1" ;
          }
        }
      } else {
        $tmp .= " $i" ;
      }
    }
    my @tmp = (glob($tmp));
    foreach $i (@tmp) {
      if ( -d $i ) {
        exec "rm -rf $i";
      } else {
        unlink $i;
      }
    }
}
##########################################################################

sub my_reader {
  my ($myfile)=@_;
  if (-f $myfile) {
    open(my $fh,"<$myfile");
    my @tab=<$fh>;
    my $buf="";
    for (@tab) { 
      my $line=$_;
      if (/^\$/) {eval $buf;$buf=$line;}
      else { $buf.=$line }
    }
    if ($buf =~ /^\$/) {eval $buf}
    close($fh);
  }
  else {
  print "File : $myfile \n=> not found\n"}
}

sub my_hashofhash_writer {
# &my_hashofhash_writter("write_hashofhash","failures",%hash1);
  my ($myfile,$hashname,%myhashofhash)=@_;
  open(my $fh,"$myfile");
  for (keys %myhashofhash) { 
    my $key1=$_;
    my %myhash=%{$myhashofhash{$key1}};
    for (sort keys %myhash) { 
      my $key2=$_;
      my $val=$myhash{$key2};
      print "\$$hashname\{'$key1'\}\{'$key2'\}='$val'\n"; 
      print $fh "\$$hashname\{'$key1'\}\{'$key2'\}='$val'\n"; 
    }
  }
  close($fh);
}

sub my_hashofhash_writer_sorted {
# &my_hashofhash_writter("write_hashofhash","failures",%hash1);
  my ($myfile,$hashname,%myhashofhash)=@_;
  # print $trace_fh "########################## WRITING tracker file ##################################\n";
  # print $trace_fh Dumper ( \%myhashofhash );
  open(my $fh,"$myfile");
  for (sort keys %myhashofhash) { 
    my $key1=$_;
    my %myhash=%{$myhashofhash{$key1}};
    my $sep1='#' x 40;$sep1.="\n";
    my $sep2='#' x 70;$sep2.="\n";
    for (grep { not ($_ eq 'Extract' or $_ eq 'Ref_extract') } sort keys %myhash) { 
      my $key2=$_;

      my $val=$myhash{$key2};
      # If some changes are detected while tracking (diff are not the same from one CL to another one), we want to add it into tracker file
      if ($key2 eq 'Extra_infos') {
        # Just remove first blank char
        if (defined $detected_changes{$key1} and $detected_changes{$key1} ne '' and defined $val and $val eq ' ') { $val = ''; }
        if (defined $detected_changes{$key1} and $detected_changes{$key1} ne '') {
            $val .= $detected_changes{$key1}."\n(in a previous run)\n! WARNING ! Job results line displays the more recent detected numerical difference";
        } 
        # print $trace_fh "########################## ADDING EXTRA INFO SUFFIX in tracker file ##################################\n";
        # print $trace_fh "  val : $val\n";
      }
      $val = '' if (!defined $val);
      print $fh "\$$hashname\{'$key1'\}\{'$key2'\}='$val'\n"; 
    }
    print $fh $sep1; 
    for (grep { $_ eq 'Extract' or $_ eq 'Ref_extract' } (sort keys %myhash)) { 
      my $key2=$_;
      my $val=$myhash{$key2};
      print $fh "\$$hashname\{'$key1'\}\{'$key2'\}='$val'\n"; 
    }
    print $fh $sep2; 
    print $fh $sep2; 
  }
  close($fh);
}

sub my_hash_writer {
# &my_hash_writter("write_hash","failures",%hash1);
  my ($myfile,$hashname,%myhash)=@_;
  open(my $fh,"$myfile");
  for (keys %myhash) { 
    my $key1=$_;
    my $val=$myhash{$key1};
    print $fh "\$$hashname\{'$key1'\}='$val'\n"; 
  }
  close($fh);
}

sub my_hash_writer_sorted {
# &my_hash_writter("write_hash","failures",%hash1);
  my ($myfile,$hashname,%myhash)=@_;
  open(my $fh,"$myfile");
  for (sort keys %myhash) { 
    my $key1=$_;
    my $val=$myhash{$key1};
    print $fh "\$$hashname\{'$key1'\}='$val'\n"; 
  }
  my $sep1='#' x 70;$sep1.="\n";
  print $fh $sep1; 
  print $fh $sep1; 
  close($fh);
}

sub checksum_failures {
    my ($string) = @_;
    if ($tracker_failures_suffix) {
      return $tracker_failures_suffix;}
    else {
      return unpack("%32A*",$string);}
}

sub init_failure {
  my ($failure_key,$type)=@_;
  use POSIX qw(strftime);
  $failures{$failure_key}{'Key'}=$failure_key;
  $failures{$failure_key}{'Status_flag'}=0;
  $failures{$failure_key}{'Status_flag_date'}=strftime("%d %B %Y  %H:%M", localtime($time));
  $failures{$failure_key}{'Old_issue'}=0;
  $failures{$failure_key}{'Status_flag'}=0;
  $failures{$failure_key}{'Date_first_detected'}=strftime("%d %B %Y  %H:%M", localtime($time));
  $failures{$failure_key}{'Execname'}=$execname;
  $failures{$failure_key}{'Changelist'}=$changelists[$i];
  $failures{$failure_key}{'Changelist_fixed'}=0;
  $failures{$failure_key}{'Input_path'}=$tests_infos{$failure_key}{'Input_path'};
  $failures{$failure_key}{'Changelist_ok'}=0;
  $failures{$failure_key}{'Extra_infos'}=' ';
  if ($type eq 'last') {$type = ''} else {$type = '_old'}
  $failures{$failure_key}{'Stdout_errors'}=$tests_infos{$failure_key}{'Stdout_errors'.$type};
  $failures{$failure_key}{'Failure_type'}=$tests_infos{$failure_key}{'Failure_type'.$type};
  if (exists $tests_infos{$failure_key}{'Timeout'.$type}) {
    $failures{$failure_key}{'Timeout'}=$tests_infos{$failure_key}{'Timeout'.$type};}
  $failures{$failure_key}{'Extract'}= join('',@{$tests_infos{$failure_key}{'Extract'.$type}});
  $failures{$failure_key}{'Ref_extract'}=join('',@{$tests_infos{$failure_key}{'Ref_extract'.$type}});
}
  
sub update_failure {
  my ($failure_key,$type)=@_;
  use POSIX qw(strftime);
  my $suffix="";
  if ($type eq 'old') { $suffix='_old' }
  if (exists $failures{$failure_key} ){
    $failures{$failure_key}{'Input_path'}=$tests_infos{$failure_key}{'Input_path'};
    $failures{$failure_key}{'Stdout_errors'}=$tests_infos{$failure_key}{'Stdout_errors'};
    if ($failures{$failure_key}{'Status_flag'} <= 0) {
    $failures{$failure_key}{'Extract'}= join('',@{$tests_infos{$failure_key}{'Extract'.$suffix}});
    $failures{$failure_key}{'Ref_extract'}=join('',@{$tests_infos{$failure_key}{'Ref_extract'.$suffix}});
    }
    if (exists $tests_infos{$failure_key}{'Timeout'}) {
        $failures{$failure_key}{'Timeout'}=$tests_infos{$failure_key}{'Timeout'};
    }
    else {delete $failures{$failure_key}{'Timeout'}}
  }
}
  
sub update_extracts {
    if (exists $tests_infos{$full_test_id}{'Ref_extract'}) {    
      @{$tests_infos{$full_test_id}{'Ref_extract_old'}}=@{$tests_infos{$full_test_id}{'Ref_extract'}};}
    if (exists $tests_infos{$full_test_id}{'Extract'}) {    
      @{$tests_infos{$full_test_id}{'Extract_old'}}=@{$tests_infos{$full_test_id}{'Extract'}};}      
    @{$tests_infos{$full_test_id}{'Ref_extract'}}=@orig_extract1;
    @{$tests_infos{$full_test_id}{'Extract'}}=@new_extract1;
    
}
sub update_within_tol {
  my ($hash_tol,$tol,$type,$code,$auth,$zero)=@_;
#  if (defined $$hash_tol{$full_test_id}{'last_val'}) {
    $$hash_tol{$full_test_id}{$orig_variable}{'old_val'}  = $$hash_tol{$full_test_id}{$orig_variable}{'last_val'};
    $$hash_tol{$full_test_id}{$orig_variable}{'old_type'} = $$hash_tol{$full_test_id}{$orig_variable}{'last_type'};
    $$hash_tol{$full_test_id}{$orig_variable}{'old_code'} = $$hash_tol{$full_test_id}{$orig_variable}{'last_code'};
    $$hash_tol{$full_test_id}{$orig_variable}{'old_auth'} = $$hash_tol{$full_test_id}{$orig_variable}{'last_auth'};
    $$hash_tol{$full_test_id}{$orig_variable}{'old_obs'} = $$hash_tol{$full_test_id}{$orig_variable}{'last_obs'};
#  }
  $$hash_tol{$full_test_id}{$orig_variable}{'last_val'}=$tol;
  $$hash_tol{$full_test_id}{$orig_variable}{'last_type'}=$type;
  $$hash_tol{$full_test_id}{$orig_variable}{'last_code'}=$code;
  $$hash_tol{$full_test_id}{$orig_variable}{'last_auth'}=$auth;
  $$hash_tol{$full_test_id}{$orig_variable}{'last_obs'}=$zero;
}
